1 Parkinson’s Disease example

Use Principal Component Analysis (PCA), Singular Value Decomposition (SVD), Independent component analysis(ICA), Factor analysis (FA) to reduce the dimensionality of the PD data. Interpret each of the results.

library(xml2)
library(rvest)
library(plotly)
library("devtools")
devtools::install_github("kassambara/factoextra")
library("factoextra")

pd<-read_html('https://wiki.socr.umich.edu/index.php/SOCR_Data_PD_BiomedBigMetadata')
html_nodes(pd, "#content")
## {xml_nodeset (1)}
## [1] <div id="content" class="mw-body" role="main">\n\t\t\t<a id="top"></a>\n\ ...
pd<- html_table(html_nodes(pd, "table")[[1]])
##PCA
pd$Dx <- gsub("PD", 1, pd$Dx)
pd$Dx <- gsub("HC", 0, pd$Dx)
pd$Dx <- gsub("SWEDD", 0,pd$Dx)
pd$Dx <- as.numeric(pd$Dx)
pd<-pd[, -c(1, 33)]
pca <- princomp(pd, cor=TRUE)
summary(pca) 
## Importance of components:
##                            Comp.1     Comp.2     Comp.3    Comp.4     Comp.5
## Standard deviation     1.39495952 1.28668145 1.28111293 1.2061402 1.18527282
## Proportion of Variance 0.06277136 0.05340481 0.05294356 0.0469282 0.04531844
## Cumulative Proportion  0.06277136 0.11617617 0.16911973 0.2160479 0.26136637
##                            Comp.6   Comp.7     Comp.8    Comp.9    Comp.10
## Standard deviation     1.15961464 1.135510 1.10882348 1.0761943 1.06687730
## Proportion of Variance 0.04337762 0.041593 0.03966095 0.0373611 0.03671701
## Cumulative Proportion  0.30474399 0.346337 0.38599794 0.4233590 0.46007604
##                           Comp.11    Comp.12    Comp.13   Comp.14    Comp.15
## Standard deviation     1.05784209 1.04026215 1.03067437 1.0259684 0.99422375
## Proportion of Variance 0.03609774 0.03490791 0.03426741 0.0339552 0.03188648
## Cumulative Proportion  0.49617378 0.53108169 0.56534910 0.5993043 0.63119078
##                           Comp.16    Comp.17    Comp.18    Comp.19    Comp.20
## Standard deviation     0.97385632 0.96688855 0.92687735 0.92376374 0.89853718
## Proportion of Variance 0.03059342 0.03015721 0.02771296 0.02752708 0.02604416
## Cumulative Proportion  0.66178421 0.69194141 0.71965437 0.74718145 0.77322561
##                           Comp.21    Comp.22    Comp.23    Comp.24    Comp.25
## Standard deviation     0.88924412 0.87005195 0.86433816 0.84794183 0.82232529
## Proportion of Variance 0.02550823 0.02441905 0.02409937 0.02319372 0.02181351
## Cumulative Proportion  0.79873384 0.82315289 0.84725226 0.87044598 0.89225949
##                           Comp.26    Comp.27    Comp.28    Comp.29    Comp.30
## Standard deviation     0.80703739 0.78546699 0.77505522 0.76624322 0.68806884
## Proportion of Variance 0.02100998 0.01990188 0.01937776 0.01893963 0.01527222
## Cumulative Proportion  0.91326947 0.93317135 0.95254911 0.97148875 0.98676096
##                           Comp.31
## Standard deviation     0.64063259
## Proportion of Variance 0.01323904
## Cumulative Proportion  1.00000000
#At around the first 18 principal components explain 72% of the variation. This is an acceptably large percentage.

fviz_pca_biplot(pca, axes = c(1, 2), geom = "point",
                col.ind = "black", col.var = "steelblue", label = "all",
                invisible = "none", labelsize = 2, pointsize = 2, repel = F, habillage = pd$Sex, palette = NULL, addEllipses = TRUE, title = "PCA - Biplot")

# Similar features/ scores of principal component are closer to each other. The magnitude projection/direction represents positive and negative association of Dimension. For example, R_Putamen Volume is positive associated with Dim2 but negative associated with Dim1. The points are coloured and grouped by gender. Visually, Male (Blue) has higher score of Dim2 than Female (Red) although their diffrence is not significant for Dim1.

plot_ly(x = c(1:length(pca$sdev)), y = pca$sdev*pca$sdev, name = "Scree", type = "bar") %>%
  layout(title="Scree Plot", xaxis = list(title="PC's"),  yaxis = list(title="Variances (SD^2)"))
# Variance decrease with more principal components involved.

scores <- pca$scores
loadings <- pca$loadings
scaleLoad <- 10

p <- plot_ly() %>%
  add_trace(x=scores[,1], y=scores[,2], z=scores[,3], type="scatter3d", mode="markers", name=pd$Dx,
            marker = list(color=pd$Dx, colorscale = c("gray", "red"), opacity = 0.7), showlegend=F) 

for (k in 1:nrow(loadings)) {
  x <- c(0, loadings[k,1])*scaleLoad
  y <- c(0, loadings[k,2])*scaleLoad
  z <- c(0, loadings[k,3])*scaleLoad
  p <- p %>% add_trace(x=x, y=y, z=z, type="scatter3d", mode="lines", 
                       name=paste0("Loading PC ", k, " ", colnames(pd)[k]), line=list(width=8), opacity=1) 
}

p <- p %>%
  layout(legend = list(orientation = 'h'), 
         title=paste0("3D Projection of ", length(pca$sdev),"D PD Data along First 3 PCs (Colored by Dx)")) 
p
#Although not distinctive, the red and gray markers were separated by Y-axis (second principal component)
## SVD
zvars<-scale(pd)
z.svd<-svd(zvars)
z.svd$d/sqrt(nrow(pd)-1)
##  [1] 1.3949595 1.2866814 1.2811129 1.2061402 1.1852728 1.1596146 1.1355100
##  [8] 1.1088235 1.0761943 1.0668773 1.0578421 1.0402622 1.0306744 1.0259684
## [15] 0.9942238 0.9738563 0.9668886 0.9268774 0.9237637 0.8985372 0.8892441
## [22] 0.8700520 0.8643382 0.8479418 0.8223253 0.8070374 0.7854670 0.7750552
## [29] 0.7662432 0.6880688 0.6406326
z.svd$v
##               [,1]         [,2]         [,3]          [,4]        [,5]
##  [1,] -0.124726889  0.171520917 -0.207698342  0.2696940060 -0.03514716
##  [2,] -0.160350863 -0.122820489 -0.048389962  0.3492630117  0.04321114
##  [3,] -0.119968795  0.042043969  0.072224364 -0.1258861652 -0.24536328
##  [4,] -0.048452104 -0.178282674 -0.128494946  0.1873141188 -0.02719269
##  [5,]  0.112258314  0.214334338 -0.383213875 -0.0895576878  0.09900782
##  [6,] -0.002621986 -0.133484674 -0.094326816 -0.4364647070 -0.15483421
##  [7,] -0.162651540 -0.043902160 -0.197033470 -0.1718745097 -0.14488319
##  [8,]  0.184478745  0.433945587 -0.101921501 -0.0700731158 -0.16390281
##  [9,]  0.001927801  0.278690194  0.058267919 -0.0746696615  0.17851736
## [10,] -0.029095301  0.056518765  0.169254759 -0.2718217042 -0.07252699
## [11,] -0.165175280 -0.012022057 -0.058769583 -0.0088742612 -0.04827646
## [12,] -0.234487029 -0.260620392 -0.096727359 -0.0542797881  0.28114571
## [13,]  0.042176667 -0.058018186  0.177442557  0.0002055726 -0.11955136
## [14,]  0.035055806 -0.089089365  0.368110224  0.0455236125  0.12830579
## [15,] -0.005237879 -0.368763318 -0.134324207  0.0294342413 -0.03196249
## [16,] -0.060814192  0.159262984 -0.102847954  0.2819372436 -0.15050584
## [17,]  0.048585764  0.069071617 -0.102924103  0.1827919145 -0.10659484
## [18,]  0.111012683 -0.078404326  0.161514046  0.1216772432 -0.19373855
## [19,] -0.051033369  0.192308841 -0.015692110  0.1682676694 -0.22237217
## [20,]  0.014013178 -0.099504825 -0.206959459  0.0366528925  0.20569161
## [21,] -0.084447516  0.073661573 -0.168364008  0.2159381310  0.39365819
## [22,] -0.102561483 -0.172584400 -0.011971992  0.2273288121 -0.40801740
## [23,]  0.025655811  0.324509150  0.207311466  0.0838750312  0.09807992
## [24,]  0.082110125 -0.153604146 -0.150267410 -0.1569759760  0.08780654
## [25,]  0.017926755 -0.199736733 -0.141769183 -0.1601870028 -0.22347777
## [26,]  0.529205990 -0.171136515 -0.016101076  0.1190850138 -0.08435556
## [27,]  0.179940303 -0.073252603  0.426266410  0.0901749749  0.11242325
## [28,] -0.328704362  0.001391286  0.307550208 -0.0055498952 -0.11102501
## [29,] -0.315173680 -0.097343962  0.129275993  0.0348181191  0.24540513
## [30,]  0.193582492 -0.175090349 -0.012588491  0.3122151045 -0.09440298
## [31,]  0.422957832 -0.098837533  0.006513844 -0.0436413622  0.22539596
##                [,6]         [,7]         [,8]         [,9]         [,10]
##  [1,]  0.1193788468  0.011896366 -0.166624872 -0.351499809  0.1012283955
##  [2,]  0.0001512498  0.272731860  0.125869982  0.005646878  0.0544857488
##  [3,] -0.3746784194  0.199148199 -0.092110323  0.078980845 -0.0684488606
##  [4,] -0.4412562621 -0.013019729 -0.162015868 -0.038477298  0.0713194411
##  [5,] -0.1812156999 -0.044137411  0.126994472 -0.034688804 -0.0601921976
##  [6,] -0.2082993045  0.087409151 -0.006990278  0.021260698  0.1686433499
##  [7,] -0.2078801319 -0.036937306  0.239181919 -0.347566960  0.0710903475
##  [8,] -0.0029299387 -0.096760562  0.145613307 -0.116627138  0.1291926360
##  [9,] -0.2825481606 -0.102640636  0.065742968  0.291072624 -0.0030885892
## [10,]  0.1868597996  0.272696495 -0.188079057 -0.033480112  0.0001874029
## [11,] -0.2048310015 -0.446700856 -0.162313704  0.159954898  0.2759146623
## [12,] -0.1515506952  0.013128258  0.054817391 -0.250618378  0.2024943631
## [13,]  0.1188148492 -0.130064631  0.493468068  0.086304929  0.0069647767
## [14,]  0.0914106373 -0.233898905  0.054030626 -0.229060543 -0.0630931999
## [15,]  0.0460293455 -0.370357706  0.169773652 -0.062785179 -0.1183079108
## [16,]  0.1741874282  0.121924333 -0.003126492  0.261651123  0.2135692857
## [17,] -0.0177952922  0.105346856 -0.214328523 -0.134495128  0.2647223835
## [18,] -0.0125854435  0.186066803  0.096737684 -0.282691044  0.4372898079
## [19,]  0.0165566508 -0.472405522 -0.020433159  0.038923948  0.1325043884
## [20,]  0.1074378634 -0.097254127 -0.239984221 -0.187264888 -0.2936266162
## [21,] -0.0083624094  0.047280684  0.226415855  0.178069241  0.1253654151
## [22,] -0.0620932326  0.084693571  0.184390351 -0.018578135 -0.2679231430
## [23,] -0.0704267987 -0.003766098  0.153626821 -0.214154022  0.0053041843
## [24,]  0.3449546805 -0.103749493 -0.262393163  0.059197484  0.2869926967
## [25,]  0.2578357486 -0.033062288  0.182740153  0.206680857  0.2812797953
## [26,] -0.1504412266 -0.019427934  0.050422616 -0.022723953 -0.0521649634
## [27,] -0.1382493452 -0.144114765 -0.101070038 -0.159261713  0.2105988121
## [28,] -0.0784926244 -0.098566294 -0.245466936  0.139244608  0.0079280125
## [29,] -0.0298020028  0.110560978  0.235652724  0.153806976  0.1884700452
## [30,] -0.1147231706  0.022427495 -0.171235383  0.289453890 -0.0622135324
## [31,] -0.1673150941  0.117686280  0.021972982  0.121013640  0.2044788170
##              [,11]       [,12]         [,13]         [,14]        [,15]
##  [1,]  0.032107952  0.12924287  0.0823799113 -0.0428072124 -0.156864722
##  [2,] -0.041874739  0.05994771 -0.0139663541  0.1327164607  0.541590157
##  [3,]  0.075454499 -0.21110548 -0.1171867789  0.2575081834  0.081481702
##  [4,] -0.005460335  0.40217076 -0.0978561405 -0.1250704680  0.042849973
##  [5,] -0.029833887 -0.30047737  0.0008814869 -0.0106022422  0.015074169
##  [6,]  0.131968158  0.04265047  0.0329848163 -0.2026846680 -0.259240087
##  [7,] -0.213334738  0.08707133  0.1784987375  0.3655019454  0.095195391
##  [8,] -0.157477719 -0.12601181  0.1366218137 -0.1662551647  0.128193843
##  [9,] -0.361855301 -0.06085003 -0.0953793888 -0.1652285614 -0.025985370
## [10,]  0.014290263 -0.05773194 -0.4734058562 -0.1179384850  0.074955861
## [11,]  0.014274289 -0.13084136 -0.0048890220  0.1209842938  0.202268761
## [12,] -0.046550043 -0.09611420 -0.0775226766 -0.2664980260 -0.030068506
## [13,] -0.280559151  0.07315141 -0.3773335962  0.2710664800 -0.069269422
## [14,]  0.099722675 -0.38391205  0.3106836653 -0.1063701889  0.055629764
## [15,]  0.200354253 -0.10952156 -0.0890118275 -0.0260859500 -0.149678688
## [16,] -0.140352753  0.07337029  0.2823520705  0.0146528823 -0.278333140
## [17,]  0.201856488 -0.39765154 -0.2430340813  0.3878249746 -0.320218129
## [18,] -0.253145871 -0.13581357 -0.1371870130 -0.3855742672  0.046650084
## [19,]  0.052459629  0.10691900 -0.2982680744 -0.1419125631 -0.011329527
## [20,] -0.434219970  0.04205235 -0.2756392262  0.0437769857 -0.199409529
## [21,]  0.302297116 -0.17977392 -0.2693600638 -0.0995042155  0.134476003
## [22,] -0.103526396 -0.30142971 -0.0193618159 -0.1206453174 -0.009789851
## [23,]  0.276885963  0.25149838 -0.1394575121  0.0618664243 -0.072833664
## [24,] -0.229746471 -0.10600186 -0.0029041102  0.1187424443  0.277244671
## [25,]  0.187693429  0.18486499  0.0062857765  0.0007032762  0.002162630
## [26,]  0.095993829  0.07691441 -0.0333876851 -0.1163091680  0.024840002
## [27,] -0.093218599  0.09721678  0.0154293952  0.2645209386 -0.048816222
## [28,] -0.007152153 -0.04130734  0.0404046167 -0.0948009272  0.055645146
## [29,] -0.147832868 -0.04427752  0.0928295712  0.0270343909 -0.403064440
## [30,] -0.132877643 -0.11344903  0.0276893684 -0.0561918780 -0.103129656
## [31,] -0.022112363 -0.02829781  0.0683882235  0.1540437887 -0.025262163
##             [,16]       [,17]       [,18]        [,19]        [,20]
##  [1,] -0.13332729  0.02238740  0.36705960  0.359280723 -0.012628789
##  [2,] -0.30581871 -0.05367331 -0.15941763 -0.012438818 -0.074844511
##  [3,]  0.01033680  0.30294428  0.23456383 -0.117895773 -0.433554248
##  [4,]  0.02552537  0.21403718 -0.11074334  0.113495129  0.145408290
##  [5,]  0.13202432 -0.03604960 -0.25965510 -0.004012680  0.225266688
##  [6,] -0.31515781 -0.33833157 -0.02453322  0.066349202 -0.042571325
##  [7,]  0.25586621 -0.09706911  0.09182119 -0.067422852  0.053820913
##  [8,]  0.04507113  0.25114309 -0.08411690 -0.159185560 -0.085591406
##  [9,] -0.16214830  0.04998756 -0.03319049  0.425172218 -0.303386524
## [10,] -0.01316686  0.29459260  0.10539250 -0.101379452  0.326697094
## [11,] -0.31812427  0.16738436 -0.08277688 -0.088299706  0.374043703
## [12,]  0.22766603  0.19349034  0.23806683 -0.195122578 -0.150445627
## [13,] -0.12382624 -0.05554689  0.17017277 -0.022387620  0.093599606
## [14,] -0.06929680  0.16757274  0.04671959  0.045762448 -0.042619427
## [15,] -0.22283106  0.23453927 -0.09979670 -0.077029344 -0.113863102
## [16,] -0.19797445  0.28378782  0.11735614 -0.289340926 -0.055649925
## [17,] -0.04859245 -0.09112638 -0.18189376  0.115329474 -0.049234046
## [18,] -0.07704527 -0.12657815 -0.21035534 -0.102017155 -0.025033042
## [19,]  0.20668548 -0.21649737  0.29324516 -0.106278134 -0.051056115
## [20,] -0.08841258  0.14300653 -0.20486181 -0.098659451 -0.183650428
## [21,]  0.07752981 -0.15109764  0.11581458 -0.013400674 -0.145507134
## [22,]  0.11654955  0.07920436  0.05889314  0.425908466  0.173662571
## [23,]  0.16353611  0.28813755 -0.28849202  0.151013954  0.100979785
## [24,]  0.16120700  0.05414432  0.07103796  0.337563663 -0.015862755
## [25,]  0.24998951  0.25936464 -0.28297922  0.200084756 -0.294918157
## [26,] -0.11472115  0.10702473  0.16775004  0.088206526 -0.003137721
## [27,]  0.04187125 -0.11776208 -0.11723584  0.005256434 -0.202487702
## [28,]  0.18426347 -0.04307199 -0.05837401  0.093008078  0.011239622
## [29,]  0.06985502  0.10667284 -0.04912891  0.092185747  0.235721946
## [30,]  0.40487225 -0.10679677 -0.11594470 -0.215202251  0.050910088
## [31,]  0.06229945  0.15930822  0.32672933  0.078358800  0.216690464
##              [,21]       [,22]        [,23]        [,24]       [,25]
##  [1,] -0.151371682 -0.37395175  0.229317269  0.236718875  0.09880064
##  [2,] -0.083231888 -0.17833699  0.044698576 -0.228108132 -0.20108635
##  [3,]  0.246329606 -0.08514071  0.034538009  0.061701005  0.24552528
##  [4,]  0.214742199  0.20183337  0.017427763  0.252522839 -0.10710597
##  [5,]  0.031481223 -0.32094978 -0.436637700  0.202709447 -0.04505929
##  [6,] -0.035942514 -0.11806594  0.124341350 -0.283092827 -0.09625428
##  [7,] -0.057360325 -0.11661593  0.083166440 -0.217979533 -0.25236568
##  [8,] -0.152860254  0.08907767  0.335921423  0.169270530 -0.02655020
##  [9,] -0.022558217 -0.12682844  0.022337676 -0.140679158 -0.14979798
## [10,]  0.011366164 -0.31467680  0.032600421  0.029421533 -0.38647850
## [11,] -0.059025698  0.07550383  0.146584435 -0.002282807  0.06867393
## [12,] -0.182198018  0.08260506 -0.157908849 -0.102162224  0.01453901
## [13,] -0.146854489  0.01812272  0.057148722  0.155730767  0.15518456
## [14,]  0.153576231  0.05737152  0.160959788 -0.085622918 -0.32440844
## [15,] -0.054464899 -0.37556193 -0.046844336 -0.033851928  0.20084082
## [16,]  0.001769218 -0.04585223 -0.382649955 -0.194738124 -0.13007118
## [17,] -0.093807939  0.24151853  0.038683753 -0.056264323 -0.14567251
## [18,]  0.073594129  0.02455367 -0.049954843  0.019317920  0.29228177
## [19,]  0.224639381  0.03691825 -0.100695008 -0.224959124 -0.21881804
## [20,] -0.133430361  0.17810305  0.086553320 -0.133307572 -0.10650499
## [21,] -0.046253050  0.03165545  0.092543612  0.092655742 -0.07095852
## [22,] -0.004734249  0.16864216 -0.148149321 -0.070790905 -0.06330624
## [23,]  0.011791888 -0.08797651 -0.007701363 -0.499308284  0.26107014
## [24,]  0.291672079 -0.08093967 -0.097759826 -0.192846730  0.24337723
## [25,] -0.144208675  0.03494707  0.081620008  0.160613045 -0.24300516
## [26,] -0.033083900 -0.05144611 -0.108754672 -0.066657008 -0.15084335
## [27,]  0.031816644 -0.25282299 -0.244495413  0.279353585 -0.20397369
## [28,] -0.605367824 -0.06823558 -0.187495553  0.014044921  0.07782985
## [29,]  0.295507887 -0.07361037  0.171865856  0.081420348 -0.04667017
## [30,] -0.019538357 -0.37221944  0.432911538 -0.143243070  0.04383296
## [31,] -0.319455353  0.12380232  0.012188584 -0.132552980  0.05634309
##              [,26]        [,27]        [,28]        [,29]       [,30]
##  [1,] -0.121793897 -0.145491473  0.021191456  0.039405383 -0.07811788
##  [2,] -0.130865200 -0.047643343  0.042668406 -0.348455561  0.12202425
##  [3,] -0.091060628 -0.189481653 -0.140811692 -0.082391182 -0.11487824
##  [4,]  0.445213679 -0.138304301  0.119209841 -0.087773524  0.03667258
##  [5,] -0.085359932 -0.325956475  0.073455550 -0.157553239 -0.08709152
##  [6,]  0.085664305 -0.317609899 -0.153198707 -0.018891491  0.26866383
##  [7,]  0.204722119  0.169543956 -0.096768329  0.193523838 -0.25318717
##  [8,]  0.133168503  0.104083032 -0.177954261 -0.224957043  0.41843598
##  [9,]  0.038434878  0.248940180  0.272677254  0.116244574 -0.12899265
## [10,]  0.090077703  0.116726061 -0.001491107  0.082929194 -0.01028600
## [11,] -0.313256906 -0.030954523 -0.069904444  0.315768771 -0.03122786
## [12,] -0.237134458 -0.007496929  0.343290056  0.068238047  0.31983729
## [13,]  0.135333851 -0.364496385  0.251069089  0.009669433  0.10577334
## [14,]  0.187157359 -0.384816655  0.138525187 -0.030791922 -0.18675618
## [15,]  0.283155278  0.367778584 -0.046675554 -0.158733243 -0.00538172
## [16,]  0.206586923 -0.112183184 -0.027394706  0.190165436  0.02366650
## [17,]  0.098151957  0.135046775  0.256346342 -0.116166165  0.04606001
## [18,]  0.014167942  0.050888226 -0.084404980  0.065503210 -0.38199923
## [19,] -0.128524166  0.010898062 -0.071830865 -0.338798783 -0.07076227
## [20,] -0.104067267 -0.229603541 -0.343112368 -0.022077887 -0.10849173
## [21,]  0.273742236 -0.086024282 -0.395308817  0.313121578 -0.02976894
## [22,] -0.079650786  0.057695136 -0.234570341  0.190802988  0.27173389
## [23,] -0.031576851 -0.143867322 -0.035291600  0.105877815  0.07671391
## [24,]  0.221096064 -0.098418934 -0.061791887 -0.042286573  0.19443801
## [25,] -0.230253846 -0.129067993  0.029791142  0.048125478 -0.18706415
## [26,] -0.205831762 -0.012213837 -0.106506931 -0.019316552 -0.07170758
## [27,] -0.084717342  0.056293611 -0.237150624  0.170415139  0.33531227
## [28,]  0.202151516 -0.116422019 -0.154753356 -0.235304182 -0.11455825
## [29,] -0.185883369  0.086349190 -0.247705422 -0.348176441 -0.01186987
## [30,]  0.002385878 -0.107593926  0.164336976  0.135397114  0.07367353
## [31,]  0.028013920  0.045721467 -0.136696356 -0.234467393 -0.15600115
##              [,31]
##  [1,]  0.059192962
##  [2,]  0.070743190
##  [3,]  0.013813275
##  [4,]  0.035532603
##  [5,]  0.059170579
##  [6,]  0.072757324
##  [7,] -0.140221737
##  [8,] -0.083273527
##  [9,]  0.019147427
## [10,]  0.031119458
## [11,] -0.020583924
## [12,] -0.055708754
## [13,] -0.081793971
## [14,]  0.060281500
## [15,]  0.103987138
## [16,] -0.004291647
## [17,] -0.139302598
## [18,]  0.062845358
## [19,]  0.156622351
## [20,]  0.046982587
## [21,] -0.076130868
## [22,]  0.195914581
## [23,]  0.001536747
## [24,] -0.165862319
## [25,]  0.116537740
## [26,] -0.668753137
## [27,]  0.162559932
## [28,] -0.257998696
## [29,] -0.225913566
## [30,]  0.028088340
## [31,]  0.448573540
pca2<-princomp(pd, cor=T)
pca2
## Call:
## princomp(x = pd, cor = T)
## 
## Standard deviations:
##    Comp.1    Comp.2    Comp.3    Comp.4    Comp.5    Comp.6    Comp.7    Comp.8 
## 1.3949595 1.2866814 1.2811129 1.2061402 1.1852728 1.1596146 1.1355100 1.1088235 
##    Comp.9   Comp.10   Comp.11   Comp.12   Comp.13   Comp.14   Comp.15   Comp.16 
## 1.0761943 1.0668773 1.0578421 1.0402622 1.0306744 1.0259684 0.9942238 0.9738563 
##   Comp.17   Comp.18   Comp.19   Comp.20   Comp.21   Comp.22   Comp.23   Comp.24 
## 0.9668886 0.9268774 0.9237637 0.8985372 0.8892441 0.8700520 0.8643382 0.8479418 
##   Comp.25   Comp.26   Comp.27   Comp.28   Comp.29   Comp.30   Comp.31 
## 0.8223253 0.8070374 0.7854670 0.7750552 0.7662432 0.6880688 0.6406326 
## 
##  31  variables and  1128 observations.
loadings(pca2)
## 
## Loadings:
##                              Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
## L_caudate_ComputeArea         0.125  0.172  0.208  0.270         0.119       
## L_caudate_Volume              0.160 -0.123         0.349                0.273
## R_caudate_ComputeArea         0.120               -0.126  0.245 -0.375  0.199
## R_caudate_Volume                    -0.178  0.128  0.187        -0.441       
## L_putamen_ComputeArea        -0.112  0.214  0.383               -0.181       
## L_putamen_Volume                    -0.133        -0.436  0.155 -0.208       
## R_putamen_ComputeArea         0.163         0.197 -0.172  0.145 -0.208       
## R_putamen_Volume             -0.184  0.434  0.102         0.164              
## L_hippocampus_ComputeArea            0.279               -0.179 -0.283 -0.103
## L_hippocampus_Volume                       -0.169 -0.272         0.187  0.273
## R_hippocampus_ComputeArea     0.165                             -0.205 -0.447
## R_hippocampus_Volume          0.234 -0.261               -0.281 -0.152       
## cerebellum_ComputeArea                     -0.177         0.120  0.119 -0.130
## cerebellum_Volume                          -0.368        -0.128        -0.234
## L_lingual_gyrus_ComputeArea         -0.369  0.134                      -0.370
## L_lingual_gyrus_Volume               0.159  0.103  0.282  0.151  0.174  0.122
## R_lingual_gyrus_ComputeArea                 0.103  0.183  0.107         0.105
## R_lingual_gyrus_Volume       -0.111        -0.162  0.122  0.194         0.186
## L_fusiform_gyrus_ComputeArea         0.192         0.168  0.222        -0.472
## L_fusiform_gyrus_Volume                     0.207        -0.206  0.107       
## R_fusiform_gyrus_ComputeArea                0.168  0.216 -0.394              
## R_fusiform_gyrus_Volume       0.103 -0.173         0.227  0.408              
## Sex                                  0.325 -0.207                            
## Weight                              -0.154  0.150 -0.157         0.345 -0.104
## Age                                 -0.200  0.142 -0.160  0.223  0.258       
## Dx                           -0.529 -0.171         0.119        -0.150       
## chr12_rs34637584_GT          -0.180        -0.426        -0.112 -0.138 -0.144
## chr17_rs11868035_GT           0.329        -0.308         0.111              
## UPDRS_part_I                  0.315        -0.129        -0.245         0.111
## UPDRS_part_II                -0.194 -0.175         0.312        -0.115       
## UPDRS_part_III               -0.423                      -0.225 -0.167  0.118
##                              Comp.8 Comp.9 Comp.10 Comp.11 Comp.12 Comp.13
## L_caudate_ComputeArea         0.167  0.351  0.101           0.129         
## L_caudate_Volume             -0.126                                       
## R_caudate_ComputeArea                                      -0.211  -0.117 
## R_caudate_Volume              0.162                         0.402         
## L_putamen_ComputeArea        -0.127                        -0.300         
## L_putamen_Volume                            0.169   0.132                 
## R_putamen_ComputeArea        -0.239  0.348         -0.213           0.178 
## R_putamen_Volume             -0.146  0.117  0.129  -0.157  -0.126   0.137 
## L_hippocampus_ComputeArea           -0.291         -0.362                 
## L_hippocampus_Volume          0.188                                -0.473 
## R_hippocampus_ComputeArea     0.162 -0.160  0.276          -0.131         
## R_hippocampus_Volume                 0.251  0.202                         
## cerebellum_ComputeArea       -0.493                -0.281          -0.377 
## cerebellum_Volume                    0.229                 -0.384   0.311 
## L_lingual_gyrus_ComputeArea  -0.170        -0.118   0.200  -0.110         
## L_lingual_gyrus_Volume              -0.262  0.214  -0.140           0.282 
## R_lingual_gyrus_ComputeArea   0.214  0.134  0.265   0.202  -0.398  -0.243 
## R_lingual_gyrus_Volume               0.283  0.437  -0.253  -0.136  -0.137 
## L_fusiform_gyrus_ComputeArea                0.133           0.107  -0.298 
## L_fusiform_gyrus_Volume       0.240  0.187 -0.294  -0.434          -0.276 
## R_fusiform_gyrus_ComputeArea -0.226 -0.178  0.125   0.302  -0.180  -0.269 
## R_fusiform_gyrus_Volume      -0.184        -0.268  -0.104  -0.301         
## Sex                          -0.154  0.214          0.277   0.251  -0.139 
## Weight                        0.262         0.287  -0.230  -0.106         
## Age                          -0.183 -0.207  0.281   0.188   0.185         
## Dx                                                                        
## chr12_rs34637584_GT           0.101  0.159  0.211                         
## chr17_rs11868035_GT           0.245 -0.139                                
## UPDRS_part_I                 -0.236 -0.154  0.188  -0.148                 
## UPDRS_part_II                 0.171 -0.289         -0.133  -0.113         
## UPDRS_part_III                      -0.121  0.204                         
##                              Comp.14 Comp.15 Comp.16 Comp.17 Comp.18 Comp.19
## L_caudate_ComputeArea                 0.157   0.133           0.367   0.359 
## L_caudate_Volume             -0.133  -0.542   0.306          -0.159         
## R_caudate_ComputeArea        -0.258                   0.303   0.235  -0.118 
## R_caudate_Volume              0.125                   0.214  -0.111   0.113 
## L_putamen_ComputeArea                        -0.132          -0.260         
## L_putamen_Volume              0.203   0.259   0.315  -0.338                 
## R_putamen_ComputeArea        -0.366          -0.256                         
## R_putamen_Volume              0.166  -0.128           0.251          -0.159 
## L_hippocampus_ComputeArea     0.165           0.162                   0.425 
## L_hippocampus_Volume          0.118                   0.295   0.105  -0.101 
## R_hippocampus_ComputeArea    -0.121  -0.202   0.318   0.167                 
## R_hippocampus_Volume          0.266          -0.228   0.193   0.238  -0.195 
## cerebellum_ComputeArea       -0.271           0.124           0.170         
## cerebellum_Volume             0.106                   0.168                 
## L_lingual_gyrus_ComputeArea           0.150   0.223   0.235                 
## L_lingual_gyrus_Volume                0.278   0.198   0.284   0.117  -0.289 
## R_lingual_gyrus_ComputeArea  -0.388   0.320                  -0.182   0.115 
## R_lingual_gyrus_Volume        0.386                  -0.127  -0.210  -0.102 
## L_fusiform_gyrus_ComputeArea  0.142          -0.207  -0.216   0.293  -0.106 
## L_fusiform_gyrus_Volume               0.199           0.143  -0.205         
## R_fusiform_gyrus_ComputeArea         -0.134          -0.151   0.116         
## R_fusiform_gyrus_Volume       0.121          -0.117                   0.426 
## Sex                                          -0.164   0.288  -0.288   0.151 
## Weight                       -0.119  -0.277  -0.161                   0.338 
## Age                                          -0.250   0.259  -0.283   0.200 
## Dx                            0.116           0.115   0.107   0.168         
## chr12_rs34637584_GT          -0.265                  -0.118  -0.117         
## chr17_rs11868035_GT                          -0.184                         
## UPDRS_part_I                          0.403           0.107                 
## UPDRS_part_II                         0.103  -0.405  -0.107  -0.116  -0.215 
## UPDRS_part_III               -0.154                   0.159   0.327         
##                              Comp.20 Comp.21 Comp.22 Comp.23 Comp.24 Comp.25
## L_caudate_ComputeArea                 0.151   0.374   0.229   0.237         
## L_caudate_Volume                              0.178          -0.228  -0.201 
## R_caudate_ComputeArea         0.434  -0.246                           0.246 
## R_caudate_Volume             -0.145  -0.215  -0.202           0.253  -0.107 
## L_putamen_ComputeArea        -0.225           0.321  -0.437   0.203         
## L_putamen_Volume                              0.118   0.124  -0.283         
## R_putamen_ComputeArea                         0.117          -0.218  -0.252 
## R_putamen_Volume                      0.153           0.336   0.169         
## L_hippocampus_ComputeArea     0.303           0.127          -0.141  -0.150 
## L_hippocampus_Volume         -0.327           0.315                  -0.386 
## R_hippocampus_ComputeArea    -0.374                   0.147                 
## R_hippocampus_Volume          0.150   0.182          -0.158  -0.102         
## cerebellum_ComputeArea                0.147                   0.156   0.155 
## cerebellum_Volume                    -0.154           0.161          -0.324 
## L_lingual_gyrus_ComputeArea   0.114           0.376                   0.201 
## L_lingual_gyrus_Volume                               -0.383  -0.195  -0.130 
## R_lingual_gyrus_ComputeArea                  -0.242                  -0.146 
## R_lingual_gyrus_Volume                                                0.292 
## L_fusiform_gyrus_ComputeArea         -0.225          -0.101  -0.225  -0.219 
## L_fusiform_gyrus_Volume       0.184   0.133  -0.178          -0.133  -0.107 
## R_fusiform_gyrus_ComputeArea  0.146                                         
## R_fusiform_gyrus_Volume      -0.174          -0.169  -0.148                 
## Sex                          -0.101                          -0.499   0.261 
## Weight                               -0.292                  -0.193   0.243 
## Age                           0.295   0.144                   0.161  -0.243 
## Dx                                                   -0.109          -0.151 
## chr12_rs34637584_GT           0.202           0.253  -0.244   0.279  -0.204 
## chr17_rs11868035_GT                   0.605          -0.187                 
## UPDRS_part_I                 -0.236  -0.296           0.172                 
## UPDRS_part_II                                 0.372   0.433  -0.143         
## UPDRS_part_III               -0.217   0.319  -0.124          -0.133         
##                              Comp.26 Comp.27 Comp.28 Comp.29 Comp.30 Comp.31
## L_caudate_ComputeArea         0.122   0.145                                 
## L_caudate_Volume              0.131                  -0.348  -0.122         
## R_caudate_ComputeArea                 0.189  -0.141           0.115         
## R_caudate_Volume             -0.445   0.138   0.119                         
## L_putamen_ComputeArea                 0.326          -0.158                 
## L_putamen_Volume                      0.318  -0.153          -0.269         
## R_putamen_ComputeArea        -0.205  -0.170           0.194   0.253  -0.140 
## R_putamen_Volume             -0.133  -0.104  -0.178  -0.225  -0.418         
## L_hippocampus_ComputeArea            -0.249   0.273   0.116   0.129         
## L_hippocampus_Volume                 -0.117                                 
## R_hippocampus_ComputeArea     0.313                   0.316                 
## R_hippocampus_Volume          0.237           0.343          -0.320         
## cerebellum_ComputeArea       -0.135   0.364   0.251          -0.106         
## cerebellum_Volume            -0.187   0.385   0.139           0.187         
## L_lingual_gyrus_ComputeArea  -0.283  -0.368          -0.159           0.104 
## L_lingual_gyrus_Volume       -0.207   0.112           0.190                 
## R_lingual_gyrus_ComputeArea          -0.135   0.256  -0.116          -0.139 
## R_lingual_gyrus_Volume                                        0.382         
## L_fusiform_gyrus_ComputeArea  0.129                  -0.339           0.157 
## L_fusiform_gyrus_Volume       0.104   0.230  -0.343           0.108         
## R_fusiform_gyrus_ComputeArea -0.274          -0.395   0.313                 
## R_fusiform_gyrus_Volume                      -0.235   0.191  -0.272   0.196 
## Sex                                   0.144           0.106                 
## Weight                       -0.221                          -0.194  -0.166 
## Age                           0.230   0.129                   0.187   0.117 
## Dx                            0.206          -0.107                  -0.669 
## chr12_rs34637584_GT                          -0.237   0.170  -0.335   0.163 
## chr17_rs11868035_GT          -0.202   0.116  -0.155  -0.235   0.115  -0.258 
## UPDRS_part_I                  0.186          -0.248  -0.348          -0.226 
## UPDRS_part_II                         0.108   0.164   0.135                 
## UPDRS_part_III                               -0.137  -0.234   0.156   0.449 
## 
##                Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8 Comp.9
## SS loadings     1.000  1.000  1.000  1.000  1.000  1.000  1.000  1.000  1.000
## Proportion Var  0.032  0.032  0.032  0.032  0.032  0.032  0.032  0.032  0.032
## Cumulative Var  0.032  0.065  0.097  0.129  0.161  0.194  0.226  0.258  0.290
##                Comp.10 Comp.11 Comp.12 Comp.13 Comp.14 Comp.15 Comp.16 Comp.17
## SS loadings      1.000   1.000   1.000   1.000   1.000   1.000   1.000   1.000
## Proportion Var   0.032   0.032   0.032   0.032   0.032   0.032   0.032   0.032
## Cumulative Var   0.323   0.355   0.387   0.419   0.452   0.484   0.516   0.548
##                Comp.18 Comp.19 Comp.20 Comp.21 Comp.22 Comp.23 Comp.24 Comp.25
## SS loadings      1.000   1.000   1.000   1.000   1.000   1.000   1.000   1.000
## Proportion Var   0.032   0.032   0.032   0.032   0.032   0.032   0.032   0.032
## Cumulative Var   0.581   0.613   0.645   0.677   0.710   0.742   0.774   0.806
##                Comp.26 Comp.27 Comp.28 Comp.29 Comp.30 Comp.31
## SS loadings      1.000   1.000   1.000   1.000   1.000   1.000
## Proportion Var   0.032   0.032   0.032   0.032   0.032   0.032
## Cumulative Var   0.839   0.871   0.903   0.935   0.968   1.000
##The proportion variance are decomposed into single value of equal split between variables that summed up to 100%. The SS loadings is equal to 1 as a result of equal SD. The Loadings generated are based on the assumed equal variance. The high value of loadings is well explained by the components (between -1 to 1).
S <- matrix(runif(10000), 5000, 2)
A <- matrix(c(1, 1, -1, 3), 2, 2, byrow = TRUE)
X <- S %*% A 

cor(X)
##            [,1]       [,2]
## [1,]  1.0000000 -0.4442635
## [2,] -0.4442635  1.0000000
## The correlation between two variables is -0.4.

library(fastICA)
a <- fastICA(pd, 2, alg.typ = "parallel", fun = "logcosh", alpha = 1, 
             method = "C", row.norm = FALSE, maxit = 200, tol = 0.0001)
plot_ly() %>%  
  add_markers(x = a$X[ , 1], y =~a$X[ , 2], name="Pre-processed data", 
              marker = list(color="green", opacity=0.9, symbol=105)) %>%
  add_markers(x = a$S[ , 1], y = a$S[ , 2], name="ICA components",
              marker = list(color="blue", opacity=0.99, symbol=5))  %>% 
  layout(title='Scatter Plots of the Original (Pre-processed) Data and the corresponding ICA Transform', 
         xaxis = list(title="Twin 1 (standardized height)"), 
         yaxis = list(title="Twin 2 (standardized height)"),
         legend = list(orientation = 'h'))
#ICA Component is more concentric than the scattered pre-processed data, indicating higher precision and accurracy in the origin.

cor(a$X)
##               [,1]         [,2]          [,3]          [,4]         [,5]
##  [1,]  1.000000000  0.057949162 -0.0605763607  0.0439944567  0.009640983
##  [2,]  0.057949162  1.000000000  0.0107637202  0.0724556772 -0.066328127
##  [3,] -0.060576361  0.010763720  1.0000000000  0.0574418888 -0.015959528
##  [4,]  0.043994457  0.072455677  0.0574418888  1.0000000000 -0.017003442
##  [5,]  0.009640983 -0.066328127 -0.0159595277 -0.0170034418  1.000000000
##  [6,] -0.064299184 -0.111315248  0.0632793506  0.0219626908  0.022289469
##  [7,]  0.040808105  0.045048667  0.0786434793  0.0542874668  0.090496109
##  [8,]  0.058552841 -0.118303868  0.0070228441 -0.0943363762  0.176353726
##  [9,] -0.037932760 -0.044436146  0.0513596126  0.0061233548  0.094604791
## [10,] -0.042033469 -0.046808250  0.0857883277 -0.0779136142 -0.064425367
## [11,] -0.002783361  0.025203214  0.0485229366  0.1004441878  0.022846806
## [12,]  0.024725742  0.036380498  0.0211805872  0.1033424738  0.002255100
## [13,] -0.094952000  0.013148246 -0.0211309613 -0.0927916850 -0.080519787
## [14,] -0.061229901 -0.040458242 -0.0451142729 -0.1187781231 -0.119516694
## [15,] -0.022587205 -0.006119229 -0.0462044972  0.0419035130  0.003899237
## [16,]  0.116048548  0.070234408 -0.0111429907 -0.0196789750 -0.014868374
## [17,]  0.098853870  0.001729507  0.0715683013 -0.0189183712  0.061570896
## [18,] -0.011790657  0.069257523 -0.0393249154  0.0243463607 -0.061610619
## [19,]  0.076380247 -0.090679761 -0.0326753390  0.0224746511 -0.010221932
## [20,]  0.046459905 -0.011737155 -0.0916756764  0.0482441380  0.038593824
## [21,]  0.036679106  0.130777186 -0.0585847019 -0.0034107044  0.104620649
## [22,]  0.021681734  0.077228439  0.0873506384  0.0477616761 -0.015490109
## [23,]  0.038599173 -0.029475777 -0.0008057058  0.0003693636  0.002385885
## [24,]  0.006390781 -0.024066767 -0.0888347415 -0.0618969459  0.012788207
## [25,] -0.057579260 -0.018770009 -0.0421641960 -0.0038565579 -0.044711273
## [26,] -0.062310805 -0.041388158 -0.0528791702  0.0872425964  0.044774224
## [27,] -0.074422650 -0.039020904 -0.0015185912  0.0156824348 -0.120278347
## [28,] -0.009806497  0.011846711  0.0799225687  0.0095353912 -0.156409607
## [29,] -0.007884304  0.045224549 -0.0018960500  0.0190613314 -0.072932152
## [30,] -0.056367890  0.014983177 -0.0069141588  0.0774268220 -0.002169260
## [31,] -0.108282780 -0.077673894 -0.0432303893  0.0132678735  0.044680726
##               [,6]          [,7]          [,8]         [,9]        [,10]
##  [1,] -0.064299184  0.0408081047  0.0585528411 -0.037932760 -0.042033469
##  [2,] -0.111315248  0.0450486670 -0.1183038681 -0.044436146 -0.046808250
##  [3,]  0.063279351  0.0786434793  0.0070228441  0.051359613  0.085788328
##  [4,]  0.021962691  0.0542874668 -0.0943363762  0.006123355 -0.077913614
##  [5,]  0.022289469  0.0904961089  0.1763537262  0.094604791 -0.064425367
##  [6,]  1.000000000  0.0909392560 -0.0576876476  0.025303302  0.040415566
##  [7,]  0.090939256  1.0000000000  0.0522452643 -0.055084723 -0.088663440
##  [8,] -0.057687648  0.0522452643  1.0000000000  0.131800075 -0.001133570
##  [9,]  0.025303302 -0.0550847226  0.1318000754  1.000000000 -0.026338163
## [10,]  0.040415566 -0.0886634398 -0.0011335705 -0.026338163  1.000000000
## [11,]  0.029817182  0.0378953276  0.0158998200  0.055162016 -0.055332655
## [12,]  0.031507593  0.1240234965 -0.1405112929 -0.030065154 -0.002067794
## [13,] -0.049719667  0.0517207587 -0.0073688116  0.036032569  0.029312082
## [14,] -0.081872936 -0.0833397951  0.0110699290 -0.026242693 -0.021396812
## [15,]  0.046427275  0.0178577171 -0.1177935564 -0.112656173 -0.082089050
## [16,] -0.086196846 -0.0499646315  0.0786790785  0.002752942 -0.054125472
## [17,] -0.004577468 -0.0173173654  0.0002952288 -0.070077989  0.002641454
## [18,]  0.060976863 -0.0415054215  0.1041121238 -0.032147097  0.055886331
## [19,] -0.060191221  0.0015593749  0.0862434234  0.035623110 -0.042690471
## [20,] -0.069277282 -0.0004978113 -0.0352538013  0.028728440  0.004536290
## [21,] -0.086435977 -0.0862187955 -0.0355634205  0.055341451 -0.061342832
## [22,] -0.052259027  0.0674214741 -0.0652563727 -0.043754370 -0.032586060
## [23,] -0.110828126 -0.0274272757  0.0973109582  0.061805559  0.042336466
## [24,] -0.023769502  0.0024134816 -0.0464116174 -0.030826359  0.049807652
## [25,]  0.084860679  0.0278577339  0.0170643410 -0.112966971  0.007116462
## [26,]  0.036956288 -0.1358343053  0.0438173405 -0.027539695 -0.051600056
## [27,] -0.083706932 -0.0290481249 -0.0772912568  0.035118713 -0.028965313
## [28,] -0.004923399 -0.0271350333 -0.1006941854  0.046063832  0.063798456
## [29,] -0.001483827  0.0340820176 -0.1563259364  0.065709989 -0.010349551
## [30,] -0.075792511 -0.0758263997 -0.0403658339 -0.029103688 -0.076428306
## [31,]  0.015850363 -0.0463011268  0.0518657126  0.033468915 -0.027865092
##              [,11]        [,12]         [,13]         [,14]        [,15]
##  [1,] -0.002783361  0.024725742 -0.0949519999 -6.122990e-02 -0.022587205
##  [2,]  0.025203214  0.036380498  0.0131482460 -4.045824e-02 -0.006119229
##  [3,]  0.048522937  0.021180587 -0.0211309613 -4.511427e-02 -0.046204497
##  [4,]  0.100444188  0.103342474 -0.0927916850 -1.187781e-01  0.041903513
##  [5,]  0.022846806  0.002255100 -0.0805197869 -1.195167e-01  0.003899237
##  [6,]  0.029817182  0.031507593 -0.0497196673 -8.187294e-02  0.046427275
##  [7,]  0.037895328  0.124023497  0.0517207587 -8.333980e-02  0.017857717
##  [8,]  0.015899820 -0.140511293 -0.0073688116  1.106993e-02 -0.117793556
##  [9,]  0.055162016 -0.030065154  0.0360325687 -2.624269e-02 -0.112656173
## [10,] -0.055332655 -0.002067794  0.0293120816 -2.139681e-02 -0.082089050
## [11,]  1.000000000  0.038448935 -0.0143904209  2.032270e-02  0.102370486
## [12,]  0.038448935  1.000000000 -0.0752726871  4.000690e-02  0.104973127
## [13,] -0.014390421 -0.075272687  1.0000000000  6.668298e-04  0.072692406
## [14,]  0.020322704  0.040006898  0.0006668298  1.000000e+00  0.083014650
## [15,]  0.102370486  0.104973127  0.0726924064  8.301465e-02  1.000000000
## [16,]  0.009498144 -0.069293108 -0.0155316206 -7.902774e-02 -0.050061810
## [17,]  0.040292861 -0.057626399 -0.0459445725 -3.840406e-02 -0.012521019
## [18,] -0.058547497  0.071133697  0.0710730116  3.997070e-02 -0.046263840
## [19,]  0.126587671 -0.038315661  0.0710622522 -3.616849e-02  0.012028231
## [20,] -0.021437521  0.089799963 -0.0008680112 -6.490658e-02  0.081254470
## [21,] -0.005447456  0.125532417 -0.0166462028 -3.841863e-02  0.018667751
## [22,] -0.031054348 -0.012531124  0.0701916418  3.562701e-02  0.077002373
## [23,] -0.055625242 -0.070721253  0.0132265749  4.504427e-02 -0.086942547
## [24,]  0.044625981  0.011612721 -0.0426038997 -1.630739e-05  0.024766893
## [25,] -0.009230832  0.017065775  0.0536984565 -8.917659e-02  0.119556569
## [26,] -0.096544892 -0.111932634  0.0239674138  3.846083e-02  0.110281769
## [27,] -0.005279368 -0.055264338  0.0805322917  1.758967e-01 -0.031596541
## [28,]  0.117144032  0.067156177 -0.0334544498  6.491980e-02 -0.048783666
## [29,]  0.031223594  0.164251246  0.0606837020  5.135736e-02 -0.001114899
## [30,] -0.033459803 -0.060181517 -0.0339674861 -2.159899e-02  0.028106839
## [31,] -0.048126622  0.003011558  0.0365981815  6.805303e-04 -0.045800485
##              [,16]         [,17]        [,18]        [,19]         [,20]
##  [1,]  0.116048548  0.0988538702 -0.011790657  0.076380247  0.0464599053
##  [2,]  0.070234408  0.0017295072  0.069257523 -0.090679761 -0.0117371552
##  [3,] -0.011142991  0.0715683013 -0.039324915 -0.032675339 -0.0916756764
##  [4,] -0.019678975 -0.0189183712  0.024346361  0.022474651  0.0482441380
##  [5,] -0.014868374  0.0615708961 -0.061610619 -0.010221932  0.0385938241
##  [6,] -0.086196846 -0.0045774685  0.060976863 -0.060191221 -0.0692772822
##  [7,] -0.049964631 -0.0173173654 -0.041505421  0.001559375 -0.0004978113
##  [8,]  0.078679078  0.0002952288  0.104112124  0.086243423 -0.0352538013
##  [9,]  0.002752942 -0.0700779893 -0.032147097  0.035623110  0.0287284396
## [10,] -0.054125472  0.0026414544  0.055886331 -0.042690471  0.0045362905
## [11,]  0.009498144  0.0402928608 -0.058547497  0.126587671 -0.0214375208
## [12,] -0.069293108 -0.0576263986  0.071133697 -0.038315661  0.0897999633
## [13,] -0.015531621 -0.0459445725  0.071073012  0.071062252 -0.0008680112
## [14,] -0.079027741 -0.0384040631  0.039970704 -0.036168485 -0.0649065820
## [15,] -0.050061810 -0.0125210194 -0.046263840  0.012028231  0.0812544697
## [16,]  1.000000000  0.0509647037  0.019211806  0.045497873 -0.0271557708
## [17,]  0.050964704  1.0000000000  0.057937097  0.027781613  0.0281547429
## [18,]  0.019211806  0.0579370966  1.000000000  0.002849041 -0.0594284858
## [19,]  0.045497873  0.0277816132  0.002849041  1.000000000 -0.0419533283
## [20,] -0.027155771  0.0281547429 -0.059428486 -0.041953328  1.0000000000
## [21,] -0.012286459  0.0589518717 -0.059788104  0.044736358 -0.0356402709
## [22,]  0.020049300  0.0408787868  0.091348377  0.017539820 -0.0311141108
## [23,] -0.018427691  0.0224820427 -0.003575238  0.059660339 -0.0779122794
## [24,] -0.021538698  0.0082294805  0.018825604 -0.005905942  0.0927378070
## [25,]  0.034561725 -0.0077653940 -0.009843693 -0.008069209 -0.0712590677
## [26,] -0.050257178 -0.0115265699  0.102701122 -0.001374853 -0.0024801683
## [27,] -0.081046002  0.0362491229  0.128364143  0.003902625 -0.0354607382
## [28,] -0.005438733 -0.0449570726 -0.019325627  0.061098602 -0.0772014715
## [29,]  0.070878990 -0.0439466640 -0.001836697 -0.077617526 -0.0323223866
## [30,]  0.039747655  0.0460091933  0.056811919  0.026697285  0.0353543566
## [31,] -0.032160412  0.0491850028  0.007747446 -0.153668138 -0.0309029704
##              [,21]       [,22]         [,23]         [,24]        [,25]
##  [1,]  0.036679106  0.02168173  0.0385991734  6.390781e-03 -0.057579260
##  [2,]  0.130777186  0.07722844 -0.0294757775 -2.406677e-02 -0.018770009
##  [3,] -0.058584702  0.08735064 -0.0008057058 -8.883474e-02 -0.042164196
##  [4,] -0.003410704  0.04776168  0.0003693636 -6.189695e-02 -0.003856558
##  [5,]  0.104620649 -0.01549011  0.0023858846  1.278821e-02 -0.044711273
##  [6,] -0.086435977 -0.05225903 -0.1108281264 -2.376950e-02  0.084860679
##  [7,] -0.086218795  0.06742147 -0.0274272757  2.413482e-03  0.027857734
##  [8,] -0.035563421 -0.06525637  0.0973109582 -4.641162e-02  0.017064341
##  [9,]  0.055341451 -0.04375437  0.0618055589 -3.082636e-02 -0.112966971
## [10,] -0.061342832 -0.03258606  0.0423364655  4.980765e-02  0.007116462
## [11,] -0.005447456 -0.03105435 -0.0556252424  4.462598e-02 -0.009230832
## [12,]  0.125532417 -0.01253112 -0.0707212525  1.161272e-02  0.017065775
## [13,] -0.016646203  0.07019164  0.0132265749 -4.260390e-02  0.053698457
## [14,] -0.038418634  0.03562701  0.0450442738 -1.630739e-05 -0.089176591
## [15,]  0.018667751  0.07700237 -0.0869425473  2.476689e-02  0.119556569
## [16,] -0.012286459  0.02004930 -0.0184276912 -2.153870e-02  0.034561725
## [17,]  0.058951872  0.04087879  0.0224820427  8.229481e-03 -0.007765394
## [18,] -0.059788104  0.09134838 -0.0035752377  1.882560e-02 -0.009843693
## [19,]  0.044736358  0.01753982  0.0596603395 -5.905942e-03 -0.008069209
## [20,] -0.035640271 -0.03111411 -0.0779122794  9.273781e-02 -0.071259068
## [21,]  1.000000000 -0.06566910  0.0359503750 -3.402150e-02 -0.020751470
## [22,] -0.065669098  1.00000000 -0.0844861092 -7.136376e-02  0.031113763
## [23,]  0.035950375 -0.08448611  1.0000000000 -1.482279e-01 -0.049225520
## [24,] -0.034021504 -0.07136376 -0.1482278922  1.000000e+00  0.139051429
## [25,] -0.020751470  0.03111376 -0.0492255204  1.390514e-01  1.000000000
## [26,] -0.072316378  0.05949243 -0.0076823112 -2.283086e-02  0.041081129
## [27,] -0.097210253 -0.13244108  0.0875523358 -1.186151e-02 -0.073714992
## [28,] -0.064601120  0.08586294  0.0139690198 -7.022452e-02 -0.026469199
## [29,]  0.085498846  0.03328976  0.0142079026 -5.409860e-02  0.003748049
## [30,] -0.006664240  0.08467534 -0.0921494710  8.788121e-03 -0.001809455
## [31,]  0.028158074 -0.11879391 -0.0023184447  9.465782e-02 -0.018128786
##              [,26]        [,27]        [,28]        [,29]        [,30]
##  [1,] -0.062310805 -0.074422650 -0.009806497 -0.007884304 -0.056367890
##  [2,] -0.041388158 -0.039020904  0.011846711  0.045224549  0.014983177
##  [3,] -0.052879170 -0.001518591  0.079922569 -0.001896050 -0.006914159
##  [4,]  0.087242596  0.015682435  0.009535391  0.019061331  0.077426822
##  [5,]  0.044774224 -0.120278347 -0.156409607 -0.072932152 -0.002169260
##  [6,]  0.036956288 -0.083706932 -0.004923399 -0.001483827 -0.075792511
##  [7,] -0.135834305 -0.029048125 -0.027135033  0.034082018 -0.075826400
##  [8,]  0.043817340 -0.077291257 -0.100694185 -0.156325936 -0.040365834
##  [9,] -0.027539695  0.035118713  0.046063832  0.065709989 -0.029103688
## [10,] -0.051600056 -0.028965313  0.063798456 -0.010349551 -0.076428306
## [11,] -0.096544892 -0.005279368  0.117144032  0.031223594 -0.033459803
## [12,] -0.111932634 -0.055264338  0.067156177  0.164251246 -0.060181517
## [13,]  0.023967414  0.080532292 -0.033454450  0.060683702 -0.033967486
## [14,]  0.038460831  0.175896713  0.064919804  0.051357364 -0.021598988
## [15,]  0.110281769 -0.031596541 -0.048783666 -0.001114899  0.028106839
## [16,] -0.050257178 -0.081046002 -0.005438733  0.070878990  0.039747655
## [17,] -0.011526570  0.036249123 -0.044957073 -0.043946664  0.046009193
## [18,]  0.102701122  0.128364143 -0.019325627 -0.001836697  0.056811919
## [19,] -0.001374853  0.003902625  0.061098602 -0.077617526  0.026697285
## [20,] -0.002480168 -0.035460738 -0.077201471 -0.032322387  0.035354357
## [21,] -0.072316378 -0.097210253 -0.064601120  0.085498846 -0.006664240
## [22,]  0.059492429 -0.132441076  0.085862945  0.033289765  0.084675335
## [23,] -0.007682311  0.087552336  0.013969020  0.014207903 -0.092149471
## [24,] -0.022830857 -0.011861506 -0.070224524 -0.054098596  0.008788121
## [25,]  0.041081129 -0.073714992 -0.026469199  0.003748049 -0.001809455
## [26,]  1.000000000  0.150179558 -0.268127902 -0.266045456  0.175006841
## [27,]  0.150179558  1.000000000  0.077832012  0.014525253  0.055016524
## [28,] -0.268127902  0.077832012  1.000000000  0.076309465 -0.003920116
## [29,] -0.266045456  0.014525253  0.076309465  1.000000000 -0.029226578
## [30,]  0.175006841  0.055016524 -0.003920116 -0.029226578  1.000000000
## [31,]  0.373648507  0.122095490 -0.148043173 -0.054405917  0.114950853
##               [,31]
##  [1,] -0.1082827796
##  [2,] -0.0776738936
##  [3,] -0.0432303893
##  [4,]  0.0132678735
##  [5,]  0.0446807264
##  [6,]  0.0158503628
##  [7,] -0.0463011268
##  [8,]  0.0518657126
##  [9,]  0.0334689147
## [10,] -0.0278650925
## [11,] -0.0481266218
## [12,]  0.0030115580
## [13,]  0.0365981815
## [14,]  0.0006805303
## [15,] -0.0458004850
## [16,] -0.0321604115
## [17,]  0.0491850028
## [18,]  0.0077474458
## [19,] -0.1536681376
## [20,] -0.0309029704
## [21,]  0.0281580741
## [22,] -0.1187939072
## [23,] -0.0023184447
## [24,]  0.0946578218
## [25,] -0.0181287863
## [26,]  0.3736485068
## [27,]  0.1220954903
## [28,] -0.1480431731
## [29,] -0.0544059172
## [30,]  0.1149508533
## [31,]  1.0000000000
mean(cor(a$X))
## [1] 0.0317158
## The average value of correlation is 0.0317

cor(a$S)
##               [,1]          [,2]
## [1,]  1.000000e+00 -6.334936e-16
## [2,] -6.334936e-16  1.000000e+00
# Dimensions were reduced from 31 variables to 2 components. The correlation of two components is nearly 0.
library(nFactors)
## Loading required package: lattice
## 
## Attaching package: 'nFactors'
## The following object is masked from 'package:lattice':
## 
##     parallel
ev <- eigen(cor(pd)) # get eigenvalues
ap <- parallel(subject=nrow(pd), var=ncol(pd), rep=100, cent=.05)
nS <- nScree(x=ev$values, aparallel=ap$eigen$qevpea)
summary(nS)
## Report For a nScree Class 
## 
## Details: components 
## 
##    Eigenvalues Prop Cumu Par.Analysis Pred.eig     OC Acc.factor     AF
## 1            2    0    0            1        2 (< OC)         NA (< AF)
## 2            2    0    0            1        2                 0       
## 3            2    0    0            1        1                 0       
## 4            1    0    0            1        1                 0       
## 5            1    0    0            1        1                 0       
## 6            1    0    0            1        1                 0       
## 7            1    0    0            1        1                 0       
## 8            1    0    0            1        1                 0       
## 9            1    0    0            1        1                 0       
## 10           1    0    0            1        1                 0       
## 11           1    0    0            1        1                 0       
## 12           1    0    1            1        1                 0       
## 13           1    0    1            1        1                 0       
## 14           1    0    1            1        1                 0       
## 15           1    0    1            1        1                 0       
## 16           1    0    1            1        1                 0       
## 17           1    0    1            1        1                 0       
## 18           1    0    1            1        1                 0       
## 19           1    0    1            1        1                 0       
## 20           1    0    1            1        1                 0       
## 21           1    0    1            1        1                 0       
## 22           1    0    1            1        1                 0       
## 23           1    0    1            1        1                 0       
## 24           1    0    1            1        1                 0       
## 25           1    0    1            1        1                 0       
## 26           1    0    1            1        1                 0       
## 27           1    0    1            1        1                 0       
## 28           1    0    1            1        1                 0       
## 29           1    0    1            1        1                 0       
## 30           0    0    1            1       NA                 0       
## 31           0    0    1            1       NA                NA       
## 
## 
##  Number of factors retained by index 
## 
##   noc naf nparallel nkaiser
## 1   1   1        14      14
plotnScree(nS)  

plot_ly() %>%   
  add_trace(y = nS$Analysis$Eigenvalues, type="scatter", name = 'Eigenvalues',  
            mode = 'lines+markers', marker = list(opacity=0.99, size=20, symbol=5)) %>% 
  add_trace(y = nS$Analysis$Par.Analysis, type="scatter",   
            name = 'Parallel Analysis (centiles of random eigenvalues)',    
            mode = 'lines+markers', marker = list(opacity=0.99, size=20, symbol=2)) %>% 
  # add_trace(y = nS$Analysis$OC, type="scatter",   
  #           name = 'Critical Optimal Coordinates',    
  #           mode = 'lines+markers', marker = list(opacity=0.99, size=20, symbol=3)) %>%   
  add_trace(y = nS$Analysis$Acc.factor, type="scatter",     
            name = 'Acceleration Factor',   
            mode = 'lines+markers', marker = list(opacity=0.99, size=20, symbol=15)) %>%    
  layout(title='Scree plot',    
         xaxis = list(title="Components"),  
         yaxis = list(title="Eigenvalues"), 
         legend = list(orientation = 'h'))  
##  Scree test suggest that we should use 14 factors.However, the PCA suggests around 18 factors to explain an acceptable 72% of the variation.

fit1<-factanal(pd, factors=14, rotation="varimax")
fit1
## 
## Call:
## factanal(x = pd, factors = 14, rotation = "varimax")
## 
## Uniquenesses:
##        L_caudate_ComputeArea             L_caudate_Volume 
##                        0.897                        0.864 
##        R_caudate_ComputeArea             R_caudate_Volume 
##                        0.874                        0.842 
##        L_putamen_ComputeArea             L_putamen_Volume 
##                        0.819                        0.693 
##        R_putamen_ComputeArea             R_putamen_Volume 
##                        0.005                        0.552 
##    L_hippocampus_ComputeArea         L_hippocampus_Volume 
##                        0.827                        0.912 
##    R_hippocampus_ComputeArea         R_hippocampus_Volume 
##                        0.777                        0.777 
##       cerebellum_ComputeArea            cerebellum_Volume 
##                        0.198                        0.337 
##  L_lingual_gyrus_ComputeArea       L_lingual_gyrus_Volume 
##                        0.779                        0.921 
##  R_lingual_gyrus_ComputeArea       R_lingual_gyrus_Volume 
##                        0.005                        0.005 
## L_fusiform_gyrus_ComputeArea      L_fusiform_gyrus_Volume 
##                        0.787                        0.005 
## R_fusiform_gyrus_ComputeArea      R_fusiform_gyrus_Volume 
##                        0.726                        0.608 
##                          Sex                       Weight 
##                        0.836                        0.757 
##                          Age                           Dx 
##                        0.872                        0.162 
##          chr12_rs34637584_GT          chr17_rs11868035_GT 
##                        0.641                        0.744 
##                 UPDRS_part_I                UPDRS_part_II 
##                        0.804                        0.872 
##               UPDRS_part_III 
##                        0.545 
## 
## Loadings:
##                              Factor1 Factor2 Factor3 Factor4 Factor5 Factor6
## L_caudate_ComputeArea                                                       
## L_caudate_Volume                                                            
## R_caudate_ComputeArea                -0.135                                 
## R_caudate_Volume                                                     -0.126 
## L_putamen_ComputeArea                                                       
## L_putamen_Volume                                                            
## R_putamen_ComputeArea                                 0.979                 
## R_putamen_Volume              0.141                                         
## L_hippocampus_ComputeArea            -0.125                                 
## L_hippocampus_Volume                 -0.101                                 
## R_hippocampus_ComputeArea            -0.120                                 
## R_hippocampus_Volume                                                        
## cerebellum_ComputeArea                                                0.889 
## cerebellum_Volume                                                           
## L_lingual_gyrus_ComputeArea           0.205                                 
## L_lingual_gyrus_Volume                                                      
## R_lingual_gyrus_ComputeArea                                   0.992         
## R_lingual_gyrus_Volume        0.990                                         
## L_fusiform_gyrus_ComputeArea                                                
## L_fusiform_gyrus_Volume                       0.992                         
## R_fusiform_gyrus_ComputeArea                         -0.105                 
## R_fusiform_gyrus_Volume                                                     
## Sex                                                                         
## Weight                                                                      
## Age                                                                         
## Dx                                    0.801                                 
## chr12_rs34637584_GT           0.127                                         
## chr17_rs11868035_GT                  -0.358                                 
## UPDRS_part_I                         -0.282                                 
## UPDRS_part_II                         0.106                                 
## UPDRS_part_III                        0.211                                 
##                              Factor7 Factor8 Factor9 Factor10 Factor11 Factor12
## L_caudate_ComputeArea                        -0.184                            
## L_caudate_Volume             -0.106                   0.234             0.113  
## R_caudate_ComputeArea                                          0.138    0.193  
## R_caudate_Volume             -0.102  -0.185           0.147             0.111  
## L_putamen_ComputeArea         0.390                                            
## L_putamen_Volume                     -0.112                   -0.108           
## R_putamen_ComputeArea                                                          
## R_putamen_Volume              0.522                  -0.318    0.136           
## L_hippocampus_ComputeArea     0.190           0.143            0.249           
## L_hippocampus_Volume                                 -0.131                    
## R_hippocampus_ComputeArea                                                      
## R_hippocampus_Volume                                  0.399                    
## cerebellum_ComputeArea                                                         
## cerebellum_Volume            -0.122   0.798                                    
## L_lingual_gyrus_ComputeArea           0.115           0.169   -0.232           
## L_lingual_gyrus_Volume                                                         
## R_lingual_gyrus_ComputeArea                                                    
## R_lingual_gyrus_Volume                                                         
## L_fusiform_gyrus_ComputeArea                 -0.188  -0.109                    
## L_fusiform_gyrus_Volume                                                        
## R_fusiform_gyrus_ComputeArea  0.166                   0.424            -0.117  
## R_fusiform_gyrus_Volume                                                 0.605  
## Sex                                                            0.342   -0.149  
## Weight                                        0.121           -0.424   -0.168  
## Age                                                           -0.312           
## Dx                                            0.368  -0.162             0.121  
## chr12_rs34637584_GT          -0.374   0.145   0.243  -0.118    0.213   -0.208  
## chr17_rs11868035_GT          -0.237                            0.101    0.123  
## UPDRS_part_I                                          0.310                    
## UPDRS_part_II                                 0.217                     0.147  
## UPDRS_part_III                                0.603                    -0.135  
##                              Factor13 Factor14
## L_caudate_ComputeArea        -0.196           
## L_caudate_Volume             -0.203           
## R_caudate_ComputeArea         0.150           
## R_caudate_Volume                       0.195  
## L_putamen_ComputeArea                         
## L_putamen_Volume              0.516           
## R_putamen_ComputeArea                         
## R_putamen_Volume             -0.112           
## L_hippocampus_ComputeArea              0.130  
## L_hippocampus_Volume          0.131   -0.158  
## R_hippocampus_ComputeArea              0.442  
## R_hippocampus_Volume          0.132           
## cerebellum_ComputeArea                        
## cerebellum_Volume                             
## L_lingual_gyrus_ComputeArea   0.113    0.178  
## L_lingual_gyrus_Volume       -0.231           
## R_lingual_gyrus_ComputeArea                   
## R_lingual_gyrus_Volume                        
## L_fusiform_gyrus_ComputeArea -0.133    0.360  
## L_fusiform_gyrus_Volume                       
## R_fusiform_gyrus_ComputeArea -0.147           
## R_fusiform_gyrus_Volume                       
## Sex                                           
## Weight                                        
## Age                                           
## Dx                                            
## chr12_rs34637584_GT                           
## chr17_rs11868035_GT                    0.179  
## UPDRS_part_I                                  
## UPDRS_part_II                -0.150           
## UPDRS_part_III                        -0.110  
## 
##                Factor1 Factor2 Factor3 Factor4 Factor5 Factor6 Factor7 Factor8
## SS loadings      1.060   1.055   1.048   1.029   1.028   0.875   0.784   0.776
## Proportion Var   0.034   0.034   0.034   0.033   0.033   0.028   0.025   0.025
## Cumulative Var   0.034   0.068   0.102   0.135   0.168   0.197   0.222   0.247
##                Factor9 Factor10 Factor11 Factor12 Factor13 Factor14
## SS loadings      0.755    0.735    0.655    0.642    0.596    0.516
## Proportion Var   0.024    0.024    0.021    0.021    0.019    0.017
## Cumulative Var   0.271    0.295    0.316    0.337    0.356    0.373
## 
## Test of the hypothesis that 14 factors are sufficient.
## The chi square statistic is 251.84 on 122 degrees of freedom.
## The p-value is 4.73e-11
## P-value less than 0.05, reject null hypothesis that 2 factors are sufficient.

fit2<-factanal(pd, factors=19, rotation="varimax")
fit2
## 
## Call:
## factanal(x = pd, factors = 19, rotation = "varimax")
## 
## Uniquenesses:
##        L_caudate_ComputeArea             L_caudate_Volume 
##                        0.840                        0.005 
##        R_caudate_ComputeArea             R_caudate_Volume 
##                        0.868                        0.849 
##        L_putamen_ComputeArea             L_putamen_Volume 
##                        0.791                        0.702 
##        R_putamen_ComputeArea             R_putamen_Volume 
##                        0.615                        0.438 
##    L_hippocampus_ComputeArea         L_hippocampus_Volume 
##                        0.476                        0.777 
##    R_hippocampus_ComputeArea         R_hippocampus_Volume 
##                        0.798                        0.522 
##       cerebellum_ComputeArea            cerebellum_Volume 
##                        0.137                        0.504 
##  L_lingual_gyrus_ComputeArea       L_lingual_gyrus_Volume 
##                        0.780                        0.698 
##  R_lingual_gyrus_ComputeArea       R_lingual_gyrus_Volume 
##                        0.005                        0.005 
## L_fusiform_gyrus_ComputeArea      L_fusiform_gyrus_Volume 
##                        0.718                        0.559 
## R_fusiform_gyrus_ComputeArea      R_fusiform_gyrus_Volume 
##                        0.663                        0.261 
##                          Sex                       Weight 
##                        0.829                        0.005 
##                          Age                           Dx 
##                        0.005                        0.005 
##          chr12_rs34637584_GT          chr17_rs11868035_GT 
##                        0.638                        0.721 
##                 UPDRS_part_I                UPDRS_part_II 
##                        0.767                        0.826 
##               UPDRS_part_III 
##                        0.616 
## 
## Loadings:
##                              Factor1 Factor2 Factor3 Factor4 Factor5 Factor6
## L_caudate_ComputeArea                                                       
## L_caudate_Volume                                              0.980         
## R_caudate_ComputeArea                                                       
## R_caudate_Volume                                                            
## L_putamen_ComputeArea                                                       
## L_putamen_Volume                                                            
## R_putamen_ComputeArea                                                       
## R_putamen_Volume                                                            
## L_hippocampus_ComputeArea                                                   
## L_hippocampus_Volume                                                        
## R_hippocampus_ComputeArea    -0.102                                         
## R_hippocampus_Volume                                                        
## cerebellum_ComputeArea                                                      
## cerebellum_Volume                                                           
## L_lingual_gyrus_ComputeArea   0.107                                   0.106 
## L_lingual_gyrus_Volume                                                      
## R_lingual_gyrus_ComputeArea                           0.989                 
## R_lingual_gyrus_Volume                0.983                                 
## L_fusiform_gyrus_ComputeArea                                                
## L_fusiform_gyrus_Volume                                                     
## R_fusiform_gyrus_ComputeArea                                                
## R_fusiform_gyrus_Volume                                                     
## Sex                                          -0.111                         
## Weight                                        0.983                         
## Age                                                                   0.984 
## Dx                            0.965                                         
## chr12_rs34637584_GT                   0.124                                 
## chr17_rs11868035_GT          -0.303                                         
## UPDRS_part_I                 -0.260                                         
## UPDRS_part_II                                                               
## UPDRS_part_III                0.332           0.104                         
##                              Factor7 Factor8 Factor9 Factor10 Factor11 Factor12
## L_caudate_ComputeArea        -0.101                                            
## L_caudate_Volume                                                               
## R_caudate_ComputeArea                                                          
## R_caudate_Volume             -0.103          -0.107  -0.182    0.174           
## L_putamen_ComputeArea                         0.299  -0.147                    
## L_putamen_Volume                                     -0.123                    
## R_putamen_ComputeArea                         0.147  -0.175    0.225           
## R_putamen_Volume                              0.698                            
## L_hippocampus_ComputeArea                                               0.708  
## L_hippocampus_Volume                                                           
## R_hippocampus_ComputeArea                                                      
## R_hippocampus_Volume                                           0.652           
## cerebellum_ComputeArea        0.920                                            
## cerebellum_Volume                                     0.690                    
## L_lingual_gyrus_ComputeArea                           0.143            -0.126  
## L_lingual_gyrus_Volume                                                         
## R_lingual_gyrus_ComputeArea                                                    
## R_lingual_gyrus_Volume                                                         
## L_fusiform_gyrus_ComputeArea                                                   
## L_fusiform_gyrus_Volume                                                        
## R_fusiform_gyrus_ComputeArea                                   0.121           
## R_fusiform_gyrus_Volume               0.844                                    
## Sex                                                                            
## Weight                                                                         
## Age                                                                            
## Dx                                                                             
## chr12_rs34637584_GT                  -0.195  -0.207   0.197                    
## chr17_rs11868035_GT                          -0.165                            
## UPDRS_part_I                                 -0.209            0.212    0.122  
## UPDRS_part_II                                                                  
## UPDRS_part_III                       -0.161                    0.104           
##                              Factor13 Factor14 Factor15 Factor16 Factor17
## L_caudate_ComputeArea                           0.113   -0.119   -0.165  
## L_caudate_Volume                                                         
## R_caudate_ComputeArea         0.174   -0.164                             
## R_caudate_Volume                                0.125             0.120  
## L_putamen_ComputeArea        -0.165                                      
## L_putamen_Volume              0.128   -0.149             0.382   -0.187  
## R_putamen_ComputeArea         0.260                              -0.218  
## R_putamen_Volume                                        -0.128           
## L_hippocampus_ComputeArea                                                
## L_hippocampus_Volume                                             -0.106  
## R_hippocampus_ComputeArea                       0.331    0.181           
## R_hippocampus_Volume         -0.114                                      
## cerebellum_ComputeArea                                                   
## cerebellum_Volume                                                        
## L_lingual_gyrus_ComputeArea            0.136    0.137    0.256           
## L_lingual_gyrus_Volume                                                   
## R_lingual_gyrus_ComputeArea                                              
## R_lingual_gyrus_Volume                                                   
## L_fusiform_gyrus_ComputeArea                    0.493   -0.113           
## L_fusiform_gyrus_Volume                0.646                             
## R_fusiform_gyrus_ComputeArea -0.544                                      
## R_fusiform_gyrus_Volume                                                  
## Sex                                                     -0.352   -0.111  
## Weight                                                   0.106           
## Age                                                                      
## Dx                                                                0.210  
## chr12_rs34637584_GT           0.227                     -0.289    0.186  
## chr17_rs11868035_GT           0.168   -0.113    0.206                    
## UPDRS_part_I                                   -0.123                    
## UPDRS_part_II                                                     0.378  
## UPDRS_part_III                        -0.121   -0.282             0.311  
##                              Factor18 Factor19
## L_caudate_ComputeArea         0.237           
## L_caudate_Volume                              
## R_caudate_ComputeArea                 -0.112  
## R_caudate_Volume                       0.113  
## L_putamen_ComputeArea                  0.164  
## L_putamen_Volume             -0.131           
## R_putamen_ComputeArea        -0.109    0.341  
## R_putamen_Volume              0.110           
## L_hippocampus_ComputeArea                     
## L_hippocampus_Volume                  -0.435  
## R_hippocampus_ComputeArea                     
## R_hippocampus_Volume                          
## cerebellum_ComputeArea                        
## cerebellum_Volume                             
## L_lingual_gyrus_ComputeArea            0.140  
## L_lingual_gyrus_Volume        0.536           
## R_lingual_gyrus_ComputeArea                   
## R_lingual_gyrus_Volume                        
## L_fusiform_gyrus_ComputeArea                  
## L_fusiform_gyrus_Volume                       
## R_fusiform_gyrus_ComputeArea                  
## R_fusiform_gyrus_Volume                       
## Sex                                           
## Weight                                        
## Age                                           
## Dx                                            
## chr12_rs34637584_GT          -0.152           
## chr17_rs11868035_GT                   -0.175  
## UPDRS_part_I                  0.127           
## UPDRS_part_II                                 
## UPDRS_part_III                                
## 
##                Factor1 Factor2 Factor3 Factor4 Factor5 Factor6 Factor7 Factor8
## SS loadings      1.282   1.029   1.026   1.019   1.013   1.011   0.921   0.838
## Proportion Var   0.041   0.033   0.033   0.033   0.033   0.033   0.030   0.027
## Cumulative Var   0.041   0.075   0.108   0.140   0.173   0.206   0.235   0.263
##                Factor9 Factor10 Factor11 Factor12 Factor13 Factor14 Factor15
## SS loadings      0.782    0.687    0.647    0.615    0.587    0.569    0.566
## Proportion Var   0.025    0.022    0.021    0.020    0.019    0.018    0.018
## Cumulative Var   0.288    0.310    0.331    0.351    0.370    0.388    0.406
##                Factor16 Factor17 Factor18 Factor19
## SS loadings       0.547    0.507    0.475    0.456
## Proportion Var    0.018    0.016    0.015    0.015
## Cumulative Var    0.424    0.440    0.455    0.470
## 
## Test of the hypothesis that 19 factors are sufficient.
## The chi square statistic is 54.51 on 47 degrees of freedom.
## The p-value is 0.211
## P-value more than 0.05, failed to reject null hypothesis that 19 factors are sufficient. 19 factors are to be used. Variables with a high loading are well explained by the factor, positively or negatively.High uniqueness of variable does not account well for its variance.

cor(pd)[1:10, 1:10]
##                           L_caudate_ComputeArea L_caudate_Volume
## L_caudate_ComputeArea               1.000000000       0.05794916
## L_caudate_Volume                    0.057949162       1.00000000
## R_caudate_ComputeArea              -0.060576361       0.01076372
## R_caudate_Volume                    0.043994457       0.07245568
## L_putamen_ComputeArea               0.009640983      -0.06632813
## L_putamen_Volume                   -0.064299184      -0.11131525
## R_putamen_ComputeArea               0.040808105       0.04504867
## R_putamen_Volume                    0.058552841      -0.11830387
## L_hippocampus_ComputeArea          -0.037932760      -0.04443615
## L_hippocampus_Volume               -0.042033469      -0.04680825
##                           R_caudate_ComputeArea R_caudate_Volume
## L_caudate_ComputeArea              -0.060576361      0.043994457
## L_caudate_Volume                    0.010763720      0.072455677
## R_caudate_ComputeArea               1.000000000      0.057441889
## R_caudate_Volume                    0.057441889      1.000000000
## L_putamen_ComputeArea              -0.015959528     -0.017003442
## L_putamen_Volume                    0.063279351      0.021962691
## R_putamen_ComputeArea               0.078643479      0.054287467
## R_putamen_Volume                    0.007022844     -0.094336376
## L_hippocampus_ComputeArea           0.051359613      0.006123355
## L_hippocampus_Volume                0.085788328     -0.077913614
##                           L_putamen_ComputeArea L_putamen_Volume
## L_caudate_ComputeArea               0.009640983      -0.06429918
## L_caudate_Volume                   -0.066328127      -0.11131525
## R_caudate_ComputeArea              -0.015959528       0.06327935
## R_caudate_Volume                   -0.017003442       0.02196269
## L_putamen_ComputeArea               1.000000000       0.02228947
## L_putamen_Volume                    0.022289469       1.00000000
## R_putamen_ComputeArea               0.090496109       0.09093926
## R_putamen_Volume                    0.176353726      -0.05768765
## L_hippocampus_ComputeArea           0.094604791       0.02530330
## L_hippocampus_Volume               -0.064425367       0.04041557
##                           R_putamen_ComputeArea R_putamen_Volume
## L_caudate_ComputeArea                0.04080810      0.058552841
## L_caudate_Volume                     0.04504867     -0.118303868
## R_caudate_ComputeArea                0.07864348      0.007022844
## R_caudate_Volume                     0.05428747     -0.094336376
## L_putamen_ComputeArea                0.09049611      0.176353726
## L_putamen_Volume                     0.09093926     -0.057687648
## R_putamen_ComputeArea                1.00000000      0.052245264
## R_putamen_Volume                     0.05224526      1.000000000
## L_hippocampus_ComputeArea           -0.05508472      0.131800075
## L_hippocampus_Volume                -0.08866344     -0.001133570
##                           L_hippocampus_ComputeArea L_hippocampus_Volume
## L_caudate_ComputeArea                  -0.037932760          -0.04203347
## L_caudate_Volume                       -0.044436146          -0.04680825
## R_caudate_ComputeArea                   0.051359613           0.08578833
## R_caudate_Volume                        0.006123355          -0.07791361
## L_putamen_ComputeArea                   0.094604791          -0.06442537
## L_putamen_Volume                        0.025303302           0.04041557
## R_putamen_ComputeArea                  -0.055084723          -0.08866344
## R_putamen_Volume                        0.131800075          -0.00113357
## L_hippocampus_ComputeArea               1.000000000          -0.02633816
## L_hippocampus_Volume                   -0.026338163           1.00000000
class <- pd$Dx
df <- as.data.frame(pd[1:5], class=class)

plot_ly(df) %>%
  add_trace(type = 'splom', dimensions = list( list(label=colnames(pd)[1], values=~L_caudate_ComputeArea),
                                               list(label=colnames(pd)[2], values=~L_caudate_Volume),
                                               list(label=colnames(pd)[3], values=~R_caudate_ComputeArea),
                                               list(label=colnames(pd)[4], values=~R_caudate_Volume),
                                               list(label=colnames(pd)[5], values=~L_putamen_ComputeArea)),
            text=~class, marker = list(line = list(width = 1, color = 'rgb(230,230,230)'))) %>%
  layout(title= 'Parkinsons Disease (PD) Data Pairs Plot', hovermode='closest', dragmode= 'select',
         plot_bgcolor='rgba(240,240,240, 0.95)')
# No relationship found among the 5 selected variables.

2 Allometric Relations in Plants example

2.1 Load data

Load Allometric Relations in Plants data and perform proper type conversion, e.g., convert “Province” and “Born”.

library(xml2)
library(rvest)
library(ggplot2)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
plt<-read_html('https://wiki.socr.umich.edu/index.php/SOCR_Data_Dinov_032708_AllometricPlanRels')
html_nodes(plt, "#content")
## {xml_nodeset (1)}
## [1] <div id="content" class="mw-body" role="main">\n\t\t\t<a id="top"></a>\n\ ...
plt<- as.data.frame(rbind(html_table(html_nodes(plt, "table")[[1]]),html_table(html_nodes(plt, "table")[[2]]),html_table(html_nodes(plt, "table")[[3]]),html_table(html_nodes(plt, "table")[[4]]),html_table(html_nodes(plt, "table")[[5]]),html_table(html_nodes(plt, "table")[[6]]),html_table(html_nodes(plt, "table")[[7]])))

library(mi)
## Loading required package: Matrix
## Loading required package: stats4
## mi (Version 1.1, packaged: 2022-06-05 05:31:15 UTC; ben)
## mi  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University
## This program comes with ABSOLUTELY NO WARRANTY.
## This is free software, and you are welcome to redistribute it
## under the General Public License version 2 or later.
## Execute RShowDoc('COPYING') for details.
mdf<-missing_data.frame(plt)
show(mdf)
## Object of class missing_data.frame with 694 observations on 8 variables
## 
## There are 2 missing data patterns
## 
## Append '@patterns' to this missing_data.frame to access the corresponding pattern for every observation or perhaps use table()
## 
##                                 type missing method  model
## Province/Sites unordered-categorical       0   <NA>   <NA>
## Alt.(m)                   continuous       0   <NA>   <NA>
## Long.(E,deg.)             continuous       0   <NA>   <NA>
## Lat.(N,deg.)              continuous       0   <NA>   <NA>
## Born                          binary       0   <NA>   <NA>
## L(g/no.)                  continuous       0   <NA>   <NA>
## M(g/no.)                  continuous       0   <NA>   <NA>
## D(no./m2)                 continuous       1    ppd linear
## 
##                  family     link transformation
## Province/Sites     <NA>     <NA>           <NA>
## Alt.(m)            <NA>     <NA>    standardize
## Long.(E,deg.)      <NA>     <NA>    standardize
## Lat.(N,deg.)       <NA>     <NA>    standardize
## Born               <NA>     <NA>           <NA>
## L(g/no.)           <NA>     <NA>    standardize
## M(g/no.)           <NA>     <NA>    standardize
## D(no./m2)      gaussian identity    standardize
mdf<-change(mdf, y=c("D(no./m2)") , what = "imputation_method", to="pmm")
imputations<-mi(mdf, n.iter=10, n.chains=3, verbose=T)
plt <- complete(imputations, 3)
plt<-plt$`chain:3`

plt<-plt[,-9]%>%mutate_at(c(1,5),as.factor)%>%mutate_at(c(1,5),as.integer)
str(plt)
## 'data.frame':    694 obs. of  8 variables:
##  $ Province.Sites: int  6 6 6 6 6 6 6 6 8 8 ...
##  $ Alt..m.       : num  800 550 441 590 800 590 876 500 880 900 ...
##  $ Long..E.deg.. : num  129 125 127 132 130 ...
##  $ Lat..N.deg..  : num  44.3 52.3 51.7 46.5 44.1 ...
##  $ Born          : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ L.g.no..      : num  17538 9313 2570 13939 14375 ...
##  $ M.g.no..      : num  610990 298385 82175 422030 450643 ...
##  $ D.no..m2.     : num  0.0394 0.0291 0.114 0.033 0.0544 ...

2.2 Apply Principal Component Analysis:

  • Generate a data summary

    summary(plt)
    ##  Province.Sites     Alt..m.     Long..E.deg..    Lat..N.deg..        Born      
    ##  Min.   : 1.00   Min.   : 150   Min.   : 81.1   Min.   :25.75   Min.   :1.000  
    ##  1st Qu.:10.00   1st Qu.:1150   1st Qu.:105.0   1st Qu.:34.34   1st Qu.:1.000  
    ##  Median :14.00   Median :1620   Median :111.8   Median :37.05   Median :1.000  
    ##  Mean   :12.73   Mean   :1789   Mean   :111.8   Mean   :37.90   Mean   :1.013  
    ##  3rd Qu.:14.75   3rd Qu.:2248   3rd Qu.:113.6   3rd Qu.:40.70   3rd Qu.:1.000  
    ##  Max.   :18.00   Max.   :4240   Max.   :134.0   Max.   :53.00   Max.   :2.000  
    ##     L.g.no..           M.g.no..         D.no..m2.      
    ##  Min.   :   143.2   Min.   :   3841   Min.   :0.01250  
    ##  1st Qu.:  3621.0   1st Qu.:  60361   1st Qu.:0.05452  
    ##  Median :  6903.1   Median : 111314   Median :0.08230  
    ##  Mean   :  9530.5   Mean   : 240227   Mean   :0.12261  
    ##  3rd Qu.: 13308.2   3rd Qu.: 289687   3rd Qu.:0.13603  
    ##  Max.   :225116.3   Max.   :9107791   Max.   :2.05350
  • Apply factoextra and compare it to the results of prcomp

    library(factoextra)
    plt1<-prcomp(as.matrix(plt), center = T)
    summary(plt1)
    ## Importance of components:
    ##                              PC1      PC2   PC3   PC4  PC5   PC6    PC7    PC8
    ## Standard deviation     4.569e+05 5.44e+03 928.6 6.283 3.76 1.942 0.1453 0.1104
    ## Proportion of Variance 9.999e-01 1.40e-04   0.0 0.000 0.00 0.000 0.0000 0.0000
    ## Cumulative Proportion  9.999e-01 1.00e+00   1.0 1.000 1.00 1.000 1.0000 1.0000
    get_eigenvalue(plt1)
    ##         eigenvalue variance.percent cumulative.variance.percent
    ## Dim.1 2.087243e+11     9.998541e+01                    99.98541
    ## Dim.2 2.959677e+07     1.417777e-02                    99.99959
    ## Dim.3 8.622529e+05     4.130458e-04                   100.00000
    ## Dim.4 3.948176e+01     1.891298e-08                   100.00000
    ## Dim.5 1.413471e+01     6.770962e-09                   100.00000
    ## Dim.6 3.772931e+00     1.807350e-09                   100.00000
    ## Dim.7 2.111185e-02     1.011323e-11                   100.00000
    ## Dim.8 1.217779e-02     5.833537e-12                   100.00000
    ##They are similar in term of variance and cumulative variance but in proportion and percent respectively.Additionally, "factoextra"shows the eigenvalue.
  • Report the rotations (scores)

    plt1$rotation
    ##                          PC1           PC2           PC3           PC4
    ## Province.Sites  1.489149e-06 -7.870210e-05 -2.499058e-03 -2.703875e-01
    ## Alt..m.         6.944255e-04 -2.494983e-02 -9.996452e-01  8.935353e-03
    ## Long..E.deg..  -6.258121e-06  3.271568e-04  7.839470e-03  9.410573e-01
    ## Lat..N.deg..   -3.197330e-06  2.367217e-05  4.316158e-03  2.030273e-01
    ## Born           -1.165447e-08  4.785827e-07  1.942249e-05  1.215124e-03
    ## L.g.no..        2.233423e-02 -9.994389e-01  2.496090e-02  1.110449e-04
    ## M.g.no..        9.997503e-01  2.234460e-02  1.367973e-04 -1.744457e-06
    ## D.no..m2.      -7.580691e-08  5.510150e-06  2.652073e-05 -5.283474e-04
    ##                          PC5           PC6           PC7           PC8
    ## Province.Sites -1.583827e-01  9.496255e-01  8.979166e-04 -3.158606e-03
    ## Alt..m.         2.543382e-03  3.355664e-04  9.425943e-06 -9.144817e-06
    ## Long..E.deg..  -2.515095e-01  2.260213e-01  2.472332e-03  8.766594e-04
    ## Lat..N.deg..    9.547613e-01  2.170602e-01 -8.547509e-03 -1.973189e-03
    ## Born           -3.071932e-04 -3.132589e-03  1.434681e-01 -9.896492e-01
    ## L.g.no..       -1.106319e-04 -4.013636e-06  5.823878e-06  1.033963e-06
    ## M.g.no..        2.420541e-06  5.511328e-07 -7.313822e-08 -1.352364e-08
    ## D.no..m2.       9.063034e-03  9.026379e-04  9.896145e-01  1.434568e-01
  • Show the scree plot

    plot_ly(x = c(1:length(plt1$sdev)), y = plt1$sdev*plt1$sdev, name = "Scree", type = "bar") %>%
      layout(title="Scree Plot", xaxis = list(title="PC's"),  yaxis = list(title="Variances (SD^2)"))
  • Select the number of PCs and employ a bootstrap test

    scores <- plt1$x
    loadings <- plt1$rotation
    
    scaleLoad <- 10
    
    p <- plot_ly(plt) %>%
      add_trace(x=scores[,2], y=scores[,3], z=scores[,4], type="scatter3d", mode="markers", name="",
                marker = list(color=plt[,1], colorscale = c("#FFE1A1", "#683531"), opacity = 0.7)) 
    for (k in 1:ncol(loadings)) {
      x <- c(0, loadings[8, k])*scaleLoad  
      y <- c(0, loadings[7, k])*scaleLoad
      z <- c(0, loadings[6, k])*scaleLoad
      p <- p %>% add_trace(x=x, y=y, z=z, type="scatter3d", mode="lines", 
                           name=paste0("Loading PC ", k, " ", colnames(plt)[k]), line=list(width=8), opacity=1) 
    }
    
    p <- p %>%
      layout(legend = list(orientation = 'h'), title="3D Projection of 6D Data along First 3 PCs",
             scene = list ( xaxis = list(title = rownames(loadings)[8]),
                            yaxis = list(title = rownames(loadings)[7]),
                            zaxis = list(title = rownames(loadings)[6]))) 
    p
    # both scree plot and 3D Scatterplot resulted in only one factor.
    
    num_boot = 1000
    bootstrap_it = function(i) {
      data_resample = plt[sample(1:nrow(plt), nrow(plt), replace=TRUE),] 
      p_resample = princomp(data_resample,cor = T) 
      return(sum(p_resample$sdev[1:3]^2)/sum(p_resample$sdev^2))
    }
    
    pco = data.frame(per=sapply(1:num_boot, bootstrap_it)) 
    quantile(pco$per, probs = c(0.025,0.975)) 
    ##      2.5%     97.5% 
    ## 0.7633534 0.8014338
    plot_ly(x = pco$per, type = "histogram", name = "Data Histogram") %>% 
        layout(title='Histogram of a Bootstrap Simulation <br /> Percent of Data Variability Captured by first 3 PCs', 
               xaxis = list(title = "Percent of Variability"), yaxis = list(title = "Frequency Count"), bargap=0.1)
    #CI(95%) = (0.763,0.802)
  • Perform SVD and ICA and compare the results of PCA.

    • Use these three variables “L”,“M”,“D” to perform ICA and show pair-plots of before-ICA and after-ICA scatter in the data. scatter3dplot() may be helpful, which you saw in Chapter 4
    zvars<-scale(plt)
    z.svd<-svd(zvars)
    z.svd$d/sqrt(nrow(plt)-1)
    ## [1] 1.9245494 1.2499831 0.9869642 0.9274467 0.6005291 0.5308719 0.3864064
    ## [8] 0.3280643
    z.svd$v
    ##            [,1]       [,2]        [,3]        [,4]        [,5]          [,6]
    ## [1,]  0.4218752 -0.2899595 -0.09337734  0.05574536  0.47099467 -0.5693923102
    ## [2,]  0.4549640 -0.1698082 -0.09182550  0.02525678 -0.22123428  0.6526057654
    ## [3,] -0.4502663  0.2089038  0.12365301 -0.12773157 -0.39643098 -0.2939384467
    ## [4,] -0.4226654  0.2179969  0.07221768  0.16156935  0.71447648  0.3744330449
    ## [5,] -0.1229859  0.1126755 -0.88974217 -0.41967231  0.06214946  0.0169885407
    ## [6,]  0.3035750  0.6104180 -0.03299552  0.14205209  0.10395439  0.0005771077
    ## [7,]  0.2890584  0.6165670 -0.05683920  0.19547456 -0.12255895 -0.1406160145
    ## [8,] -0.2068943 -0.1745407 -0.40790043  0.84812770 -0.17859307 -0.0568892737
    ##              [,7]        [,8]
    ## [1,] -0.424222557 -0.01046694
    ## [2,] -0.529012385 -0.02025023
    ## [3,] -0.682894354  0.11005460
    ## [4,] -0.269909264 -0.13778078
    ## [5,] -0.012160076 -0.01066173
    ## [6,]  0.007739487  0.70929393
    ## [7,] -0.026385790 -0.67776074
    ## [8,] -0.009023904  0.07624725
    plt3<-princomp(plt, cor=T)
    plt3
    ## Call:
    ## princomp(x = plt, cor = T)
    ## 
    ## Standard deviations:
    ##    Comp.1    Comp.2    Comp.3    Comp.4    Comp.5    Comp.6    Comp.7    Comp.8 
    ## 1.9245494 1.2499831 0.9869642 0.9274467 0.6005291 0.5308719 0.3864064 0.3280643 
    ## 
    ##  8  variables and  694 observations.
    loadings(plt3)
    ## 
    ## Loadings:
    ##                Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
    ## Province.Sites  0.422  0.290                0.471  0.569  0.424       
    ## Alt..m.         0.455  0.170               -0.221 -0.653  0.529       
    ## Long..E.deg..  -0.450 -0.209 -0.124 -0.128 -0.396  0.294  0.683 -0.110
    ## Lat..N.deg..   -0.423 -0.218         0.162  0.714 -0.374  0.270  0.138
    ## Born           -0.123 -0.113  0.890 -0.420                            
    ## L.g.no..        0.304 -0.610         0.142  0.104               -0.709
    ## M.g.no..        0.289 -0.617         0.195 -0.123  0.141         0.678
    ## D.no..m2.      -0.207  0.175  0.408  0.848 -0.179                     
    ## 
    ##                Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
    ## SS loadings     1.000  1.000  1.000  1.000  1.000  1.000  1.000  1.000
    ## Proportion Var  0.125  0.125  0.125  0.125  0.125  0.125  0.125  0.125
    ## Cumulative Var  0.125  0.250  0.375  0.500  0.625  0.750  0.875  1.000
    ##
    ##Comp.1,5, 6,7: High loadings for Province, Latitute, Longitude & Atitude with slight variant.
    ##Comp.2 & 8: High Loading for L & M with slight variant.
    ##Comp.3 & 4: High Loading for Born & D with slight variant.
    
    S <- matrix(runif(10000), 5000, 2)
    A <- matrix(c(1, 1, -1, 3), 2, 2, byrow = TRUE)
    X <- S %*% A 
    
    cor(X)
    ##            [,1]       [,2]
    ## [1,]  1.0000000 -0.4443388
    ## [2,] -0.4443388  1.0000000
    #The correlation between the two variables is -0.4.
    
    library(fastICA)
    a <- fastICA(plt[,6:8], 2, alg.typ = "parallel", fun = "logcosh", alpha = 1, 
                 method = "C", row.norm = FALSE, maxit = 200, tol = 0.0001)
    plot_ly() %>%  
      add_markers(x = a$X[ , 1], y =~a$X[ , 2], name="Pre-processed data", 
                  marker = list(color="green", opacity=0.9, symbol=105)) %>%
      add_markers(x = a$S[ , 1], y = a$S[ , 2], name="ICA components",
                  marker = list(color="blue", opacity=0.99, symbol=5))  %>% 
      layout(title='Scatter Plots of the Original (Pre-processed) Data and the corresponding ICA Transform', 
             xaxis = list(title="Twin 1 (standardized height)"), 
             yaxis = list(title="Twin 2 (standardized height)"),
             legend = list(orientation = 'h'))
    #ICA Component is more concentric than the scattered pre-processed data, indicating higher precision and accurracy in the origin. The pre-processed data radial toward first quadrant form third quadrant.
    
    library(scatterplot3d)
    scatterplot3d(scale(a$X[,1]), scale(a$X[,2]), scale(a$X[,3]))

    # The value is concentrated over at lower end of L & D with M between the range of 0 to 5. 
    
    cor(a$X)
    ##            [,1]       [,2]       [,3]
    ## [1,]  1.0000000  0.8823959 -0.2832561
    ## [2,]  0.8823959  1.0000000 -0.2198456
    ## [3,] -0.2832561 -0.2198456  1.0000000
    # The correlation between the 3 variables 0.882(LvsM), -0.283(LvsD) and -0.220 (MvsD)
    
    cor(a$S)
    ##              [,1]         [,2]
    ## [1,] 1.000000e+00 4.072814e-14
    ## [2,] 4.072814e-14 1.000000e+00
    # Dimensions were reduced from 3 variables to 2 components. The correlation of two components is nearly 0.
  • Perform factor analysis

    • Use require(nFactors) to determine the number of the factors and show a scree plot as stated in notes;
    ev <- eigen(cor(plt)) # get eigenvalues
    ap <- parallel(subject=nrow(plt), var=ncol(plt), rep=100, cent=.05)
    plt2 <- nScree(x=ev$values, aparallel=ap$eigen$qevpea)
    summary(plt2)
    ## Report For a nScree Class 
    ## 
    ## Details: components 
    ## 
    ##   Eigenvalues Prop Cumu Par.Analysis Pred.eig     OC Acc.factor     AF
    ## 1           4    0    0            1        2                NA (< AF)
    ## 2           2    0    1            1        1 (< OC)          2       
    ## 3           1    0    1            1        1                 0       
    ## 4           1    0    1            1        0                 0       
    ## 5           0    0    1            1        0                 0       
    ## 6           0    0    1            1        0                 0       
    ## 7           0    0    1            1       NA                 0       
    ## 8           0    0    1            1       NA                NA       
    ## 
    ## 
    ##  Number of factors retained by index 
    ## 
    ##   noc naf nparallel nkaiser
    ## 1   2   1         2       2
    plotnScree(plt2)    

    # Number of factor is 2 in 3 out of 4 Cattell’s Scree test rules.
    • Use factanal() to apply FA and compare the rotation “varimax” and “promax”
    fit3<-factanal(plt, 2, rotation="varimax");fit3
    ## 
    ## Call:
    ## factanal(x = plt, factors = 2, rotation = "varimax")
    ## 
    ## Uniquenesses:
    ## Province.Sites        Alt..m.  Long..E.deg..   Lat..N.deg..           Born 
    ##          0.280          0.234          0.184          0.378          0.963 
    ##       L.g.no..       M.g.no..      D.no..m2. 
    ##          0.005          0.218          0.893 
    ## 
    ## Loadings:
    ##                Factor1 Factor2
    ## Province.Sites -0.840   0.123 
    ## Alt..m.        -0.840   0.246 
    ## Long..E.deg..   0.874  -0.230 
    ## Lat..N.deg..    0.775  -0.143 
    ## Born            0.189         
    ## L.g.no..       -0.121   0.990 
    ## M.g.no..       -0.113   0.877 
    ## D.no..m2.       0.197  -0.261 
    ## 
    ##                Factor1 Factor2
    ## SS loadings      2.877   1.968
    ## Proportion Var   0.360   0.246
    ## Cumulative Var   0.360   0.606
    ## 
    ## Test of the hypothesis that 2 factors are sufficient.
    ## The chi square statistic is 161.47 on 13 degrees of freedom.
    ## The p-value is 9.94e-28
    fit4<-factanal(plt, 2, rotation="promax");fit4
    ## 
    ## Call:
    ## factanal(x = plt, factors = 2, rotation = "promax")
    ## 
    ## Uniquenesses:
    ## Province.Sites        Alt..m.  Long..E.deg..   Lat..N.deg..           Born 
    ##          0.280          0.234          0.184          0.378          0.963 
    ##       L.g.no..       M.g.no..      D.no..m2. 
    ##          0.005          0.218          0.893 
    ## 
    ## Loadings:
    ##                Factor1 Factor2
    ## Province.Sites -0.873         
    ## Alt..m.        -0.855         
    ## Long..E.deg..   0.893         
    ## Lat..N.deg..    0.802         
    ## Born            0.197         
    ## L.g.no..                1.003 
    ## M.g.no..                0.887 
    ## D.no..m2.       0.171  -0.225 
    ## 
    ##                Factor1 Factor2
    ## SS loadings      3.002   1.855
    ## Proportion Var   0.375   0.232
    ## Cumulative Var   0.375   0.607
    ## 
    ## Factor Correlations:
    ##         Factor1 Factor2
    ## Factor1   1.000  -0.358
    ## Factor2  -0.358   1.000
    ## 
    ## Test of the hypothesis that 2 factors are sufficient.
    ## The chi square statistic is 161.47 on 13 degrees of freedom.
    ## The p-value is 9.94e-28
    # The two rotations share the same uniqueness value.
    # Promax resulted in higher loadings than varimax
    # Promax omitted lesser loadings as compared to varimax.
    # Varimax resulted in lower variance and SS Loading.
    # P-value remain the same for both rotation.
    # P-value less than 0.05, reject null hypothesis that 2 factors are sufficient.
    # Varimax assume no correlation between factors whereas promax has significant correlation.
    # Promax include factor correlation, with factor correlation of -0.36.
    • Report the loadings and consider an appropriate visualization method
    ## Factor1: High Loadings for Provinces, Atitude, Latitude & Longtitude
    ## Factor2: High Loadings for L & M
    
    #Varimax
    load <- fit3$loadings
    df <- as.data.frame(load[])
    Features <- rownames(df)
    X <- df$Factor1
    Y <- df$Factor2
    df1 <- data.frame(Features, X, Y)
    cols <- palette(rainbow(6))   
    cols <- cols[1:8] 
    
    plot_ly(df1, x = ~X, y = ~Y, text = ~Features, color = cols) %>% 
      add_markers(marker = list(opacity=0.99, size=20, color=cols, symbol=~as.numeric(as.factor(Features)))) %>% 
      add_text(textfont = list(family= "Times", size= 20, color= cols), textposition="top right") %>% 
      layout(title = '2D FA', xaxis = list(title = 'Factor 1', zeroline = TRUE,range = c(-1, 1)),
             yaxis = list(title = 'Factor 2'), showlegend = FALSE)
    #Varimax resulted in L & M with high and positive loadings of Factor 2 with negative loadings of Factor 1. Born & D are positive loaded in Factor 1 but negative loaded in Factor 2. Latitutde and Longitude have high and positive loadings of Factor 1 with negative loadings of Factor 2. Province and Altitude have high and negative loadings of Factor 1 with positive loadings of Factor 2
    
    
    #Promax
    
    load <- fit4$loadings
    df <- as.data.frame(load[])
    Features <- rownames(df)
    X <- df$Factor1
    Y <- df$Factor2
    df1 <- data.frame(Features, X, Y)
    cols <- palette(rainbow(6))   
    cols <- cols[1:8] 
    
    plot_ly(df1, x = ~X, y = ~Y, text = ~Features, color = cols) %>% 
      add_markers(marker = list(opacity=0.99, size=20, color=cols, symbol=~as.numeric(as.factor(Features)))) %>% 
      add_text(textfont = list(family= "Times", size= 20, color= cols), textposition="top right") %>% 
      layout(title = '2D FA', xaxis = list(title = 'Factor 1', zeroline = TRUE,range = c(-1, 1)),
             yaxis = list(title = 'Factor 2'), showlegend = FALSE)
    ## Overall, the loadings are not significant difference when compared with Varimax. However, Promax resulted in as L & M moving to the zero of Factor 1 (X- Axis) whereas D, Altitude, and Longitude moving toward the zero of Factor 2 (Y-axis). Province, Latitude and Born are transformed to different (+/-) relationship/association of Factor 2(Y-axis) under Promax.
  • Interpret the findings in the context of the case-study.

##PCA
##Both scree plot and 3D Scatterplot resulted in only one factor.
##The Confidence Interval (95%) has a limits of ~0.765 & ~0.803. 

##SVD

##The proportion variance are decomposed into single value of equal split between variables that summed up to 100%. The SS loadings is equal to 1 as a result of equal SD. The Loadings generated are based on the assumed equal variance. The high value of loadings is well explained by the components (between -1 to 1).
##Comp.1,5, 6,7: High loadings for Province, Latitute, Longitude & Atitude with variant.
##Comp.2 & 8: High Loading for L & M with variant.
##Comp.3 & 4: High Loading for Born & D with variant.

##ICA

##The correlation between two variables of default X is -0.4.
##ICA Component is more concentric than the scattered pre-processed data, indicating higher precision and accurracy in the origin. The pre-processed data radial toward first quadrant form third quadrant.
### The scatterplot shows that the values are concentrated over at lower end of L & D with M between the range of 0 to 5. 
##The correlation between the selected 3 variables 0.882(LvsM), -0.283(LvsD) and -0.220 (MvsD)
##Dimensions were reduced from 3 variables to 2 components. The correlation of two components is nearly 0.

##FA

##Number of factor is 2 in 3 out of 4 Cattell’s Scree test rules.
##The two rotations (Varimax vs Promax) share the same uniqueness value.
##Promax resulted in higher loadings than varimax
##Promax omitted lesser loadings as compared to varimax.
##Varimax resulted in lower variance and SS Loading.
##P-value remain the same for both rotation.
##P-value less than 0.05, reject null hypothesis that 2 factors are sufficient.
##Varimax assume no correlation between factors whereas promax has significant correlation.
##Promax include factor correlation, with factor correlation of -0.36.
##Factor1: High Loadings for Provinces, Atitude, Latitude & Longtitude
##Factor2: High Loadings for L & M
##Varimax resulted in L & M with high and positive loadings of Factor 2 with negative loadings of Factor 1. Born & D are positive loaded in Factor 1 but negative loaded in Factor 2. Latitutde and Longitude have high and positive loadings of Factor 1 with negative loadings of Factor 2. Province and Altitude have high and negative loadings of Factor 1 with positive loadings of Factor 2
## Overall, the loadings are not significant difference when compared with Varimax. However, Promax resulted in as L & M moving to the zero of Factor 1 (X- Axis) whereas D, Altitude, and Longitude moving toward the zero of Factor 2 (Y-axis). Province, Latitude and Born are transformed to different (+/-) relationship/association of Factor 2(Y-axis) under Promax.